KIDS Distribution saved on Oct 12, 2012@11:07:43 VistA Data Loader 1.0 (release) on 10.12.12 **KIDS**:VISTA_DATA_LOADER 1.0^ **INSTALL NAME** VISTA_DATA_LOADER 1.0 "BLD",8423,0) VISTA_DATA_LOADER 1.0^^0^3121012^n "BLD",8423,1,0) ^^32^32^3121012^ "BLD",8423,1,1,0) VistA Data Loader 1.0 "BLD",8423,1,2,0) "BLD",8423,1,3,0) VistA Data Loader is provided by the Johns Hopkins University School "BLD",8423,1,4,0) of Nursing, and funded by the Department of Health and Human "BLD",8423,1,5,0) Services, Office of the National Coordinator for Health Information "BLD",8423,1,6,0) Technology under Award Number #1U24OC000013-01. "BLD",8423,1,7,0) "BLD",8423,1,8,0) Copyright (C) 2012 Johns Hopkins University "BLD",8423,1,9,0) "BLD",8423,1,10,0) All portions of this release that are modified from the original "BLD",8423,1,11,0) Freedom of Information Act release provided by the Department of "BLD",8423,1,12,0) Veterans Affairs is subject to the terms of the GNU Affero General "BLD",8423,1,13,0) Public License as published by the Free Software Foundation, either "BLD",8423,1,14,0) version 3 of the License, or any later version. "BLD",8423,1,15,0) "BLD",8423,1,16,0) This program is distributed in the hope that it will be useful, but "BLD",8423,1,17,0) WITHOUT ANY WARRANTY; without even the implied warranty of "BLD",8423,1,18,0) MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU "BLD",8423,1,19,0) Affero General Public License for more details. "BLD",8423,1,20,0) "BLD",8423,1,21,0) You should have received a copy of the GNU Affero General Public "BLD",8423,1,22,0) License along with this program. If not, see "BLD",8423,1,23,0) http://www.gnu.org/licenses/ "BLD",8423,1,24,0) "BLD",8423,1,25,0) "BLD",8423,1,26,0) *** "BLD",8423,1,27,0) "BLD",8423,1,28,0) This KIDS package comprises the VistA side of the VistA Data Loader "BLD",8423,1,29,0) application. The application should ONLY be used for "BLD",8423,1,30,0) training and demonstration purposes. It is NOT intended for any use in a "BLD",8423,1,31,0) clinical or production environment. It was NOT designed, coded, or "BLD",8423,1,32,0) tested for use in a clinical or production environment. "BLD",8423,4,0) ^9.64PA^9001^1 "BLD",8423,4,9001,0) 9001 "BLD",8423,4,9001,222) y^y^f^^n^^y^o^n "BLD",8423,4,"B",9001,9001) "BLD",8423,6.3) 30 "BLD",8423,"KRN",0) ^9.67PA^779.2^20 "BLD",8423,"KRN",.4,0) .4 "BLD",8423,"KRN",.401,0) .401 "BLD",8423,"KRN",.402,0) .402 "BLD",8423,"KRN",.403,0) .403 "BLD",8423,"KRN",.5,0) .5 "BLD",8423,"KRN",.84,0) .84 "BLD",8423,"KRN",3.6,0) 3.6 "BLD",8423,"KRN",3.8,0) 3.8 "BLD",8423,"KRN",9.2,0) 9.2 "BLD",8423,"KRN",9.8,0) 9.8 "BLD",8423,"KRN",9.8,"NM",0) ^9.68A^48^44 "BLD",8423,"KRN",9.8,"NM",1,0) ISIIMP^^0^B19105 "BLD",8423,"KRN",9.8,"NM",2,0) ISIIMP02^^0^B376381 "BLD",8423,"KRN",9.8,"NM",3,0) ISIIMP03^^0^B608470 "BLD",8423,"KRN",9.8,"NM",4,0) ISIIMP04^^0^B390711 "BLD",8423,"KRN",9.8,"NM",5,0) ISIIMP05^^0^B500995 "BLD",8423,"KRN",9.8,"NM",6,0) ISIIMPR1^^0^B3704 "BLD",8423,"KRN",9.8,"NM",8,0) ISIIMPU1^^0^B135487473 "BLD",8423,"KRN",9.8,"NM",9,0) ISIIMPU2^^0^B16314614 "BLD",8423,"KRN",9.8,"NM",10,0) ISIIMPU3^^0^B3746 "BLD",8423,"KRN",9.8,"NM",11,0) ISIIMP06^^0^B622120 "BLD",8423,"KRN",9.8,"NM",12,0) ISIIMP07^^0^B495396 "BLD",8423,"KRN",9.8,"NM",13,0) ISIIMPU4^^0^B6881561 "BLD",8423,"KRN",9.8,"NM",14,0) ISIIMPU5^^0^B1460844 "BLD",8423,"KRN",9.8,"NM",15,0) ISIIMPU6^^0^B1792897 "BLD",8423,"KRN",9.8,"NM",16,0) ISIIMPR2^^0^B3180 "BLD",8423,"KRN",9.8,"NM",17,0) ISIIMP09^^0^B368521 "BLD",8423,"KRN",9.8,"NM",18,0) ISIIMP10^^0^B366470 "BLD",8423,"KRN",9.8,"NM",19,0) ISIIMP11^^0^B396503 "BLD",8423,"KRN",9.8,"NM",20,0) ISIIMP08^^0^B366185 "BLD",8423,"KRN",9.8,"NM",21,0) ISIIMP12^^0^B357413 "BLD",8423,"KRN",9.8,"NM",22,0) ISIIMP13^^0^B1361576 "BLD",8423,"KRN",9.8,"NM",23,0) ISIIMPU7^^0^B1378159 "BLD",8423,"KRN",9.8,"NM",24,0) ISIIMPU8^^0^B1524944 "BLD",8423,"KRN",9.8,"NM",25,0) ISIIMPU9^^0^B2509079 "BLD",8423,"KRN",9.8,"NM",29,0) ISIIMP14^^0^B367014 "BLD",8423,"KRN",9.8,"NM",30,0) ISIIMP15^^0^B977286 "BLD",8423,"KRN",9.8,"NM",31,0) ISIIMP16^^0^B364510 "BLD",8423,"KRN",9.8,"NM",32,0) ISIIMP17^^0^B1304142 "BLD",8423,"KRN",9.8,"NM",33,0) ISIIMPL1^^0^B19810262 "BLD",8423,"KRN",9.8,"NM",34,0) ISIIMPL2^^0^B18734993 "BLD",8423,"KRN",9.8,"NM",35,0) ISIIMPL3^^0^B3141 "BLD",8423,"KRN",9.8,"NM",36,0) ISIIMPL4^^0^B3150 "BLD",8423,"KRN",9.8,"NM",37,0) ISIIMPUA^^0^B4098 "BLD",8423,"KRN",9.8,"NM",38,0) ISIIMPUB^^0^B1561092 "BLD",8423,"KRN",9.8,"NM",39,0) ISIIMP18^^0^B956410 "BLD",8423,"KRN",9.8,"NM",40,0) ISIIMP19^^0^B1482968 "BLD",8423,"KRN",9.8,"NM",41,0) ISIIMPUC^^0^B2694725 "BLD",8423,"KRN",9.8,"NM",42,0) ISIIMP20^^0^B954833 "BLD",8423,"KRN",9.8,"NM",43,0) ISIIMP21^^0^B785929 "BLD",8423,"KRN",9.8,"NM",44,0) ISIIMPL5^^0^B31496059 "BLD",8423,"KRN",9.8,"NM",45,0) ISIIMPL6^^0^B7936504 "BLD",8423,"KRN",9.8,"NM",46,0) ISIIMPL7^^0^B51775765 "BLD",8423,"KRN",9.8,"NM",47,0) ISIIMPL8^^0^B84134788 "BLD",8423,"KRN",9.8,"NM",48,0) ISIIMPL9^^0^B80411385 "BLD",8423,"KRN",9.8,"NM","B","ISIIMP",1) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP02",2) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP03",3) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP04",4) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP05",5) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP06",11) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP07",12) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP08",20) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP09",17) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP10",18) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP11",19) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP12",21) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP13",22) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP14",29) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP15",30) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP16",31) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP17",32) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP18",39) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP19",40) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP20",42) "BLD",8423,"KRN",9.8,"NM","B","ISIIMP21",43) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL1",33) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL2",34) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL3",35) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL4",36) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL5",44) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL6",45) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL7",46) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL8",47) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPL9",48) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPR1",6) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPR2",16) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU1",8) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU2",9) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU3",10) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU4",13) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU5",14) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU6",15) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU7",23) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU8",24) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPU9",25) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPUA",37) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPUB",38) "BLD",8423,"KRN",9.8,"NM","B","ISIIMPUC",41) "BLD",8423,"KRN",19,0) 19 "BLD",8423,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",8423,"KRN",19,"NM",1,0) ISI DATA IMPORT^^0 "BLD",8423,"KRN",19,"NM","B","ISI DATA IMPORT",1) "BLD",8423,"KRN",19.1,0) 19.1 "BLD",8423,"KRN",101,0) 101 "BLD",8423,"KRN",409.61,0) 409.61 "BLD",8423,"KRN",771,0) 771 "BLD",8423,"KRN",779.2,0) 779.2 "BLD",8423,"KRN",870,0) 870 "BLD",8423,"KRN",8989.51,0) 8989.51 "BLD",8423,"KRN",8989.52,0) 8989.52 "BLD",8423,"KRN",8994,0) 8994 "BLD",8423,"KRN",8994,"NM",0) ^9.68A^12^12 "BLD",8423,"KRN",8994,"NM",1,0) ISI IMPORT APPT^^0 "BLD",8423,"KRN",8994,"NM",2,0) ISI IMPORT PAT^^0 "BLD",8423,"KRN",8994,"NM",3,0) ISI IMPORT PROB^^0 "BLD",8423,"KRN",8994,"NM",4,0) ISI IMPORT VITALS^^0 "BLD",8423,"KRN",8994,"NM",5,0) ISI IMPORT ALLERGY^^0 "BLD",8423,"KRN",8994,"NM",6,0) ISI IMPORT LAB^^0 "BLD",8423,"KRN",8994,"NM",7,0) ISI IMPORT MED^^0 "BLD",8423,"KRN",8994,"NM",8,0) ISI IMPORT NOTE^^0 "BLD",8423,"KRN",8994,"NM",9,0) ISI IMPORT CONSULT^^0 "BLD",8423,"KRN",8994,"NM",10,0) ISI IMPORT TABLEFETCH^^0 "BLD",8423,"KRN",8994,"NM",11,0) ISI IMPORT RAD ORDER^^0 "BLD",8423,"KRN",8994,"NM",12,0) ISI IMPORT ICDFIND^^0 "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT ALLERGY",5) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT APPT",1) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT CONSULT",9) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT ICDFIND",12) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT LAB",6) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT MED",7) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT NOTE",8) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT PAT",2) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT PROB",3) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT RAD ORDER",11) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT TABLEFETCH",10) "BLD",8423,"KRN",8994,"NM","B","ISI IMPORT VITALS",4) "BLD",8423,"KRN","B",.4,.4) "BLD",8423,"KRN","B",.401,.401) "BLD",8423,"KRN","B",.402,.402) "BLD",8423,"KRN","B",.403,.403) "BLD",8423,"KRN","B",.5,.5) "BLD",8423,"KRN","B",.84,.84) "BLD",8423,"KRN","B",3.6,3.6) "BLD",8423,"KRN","B",3.8,3.8) "BLD",8423,"KRN","B",9.2,9.2) "BLD",8423,"KRN","B",9.8,9.8) "BLD",8423,"KRN","B",19,19) "BLD",8423,"KRN","B",19.1,19.1) "BLD",8423,"KRN","B",101,101) "BLD",8423,"KRN","B",409.61,409.61) "BLD",8423,"KRN","B",771,771) "BLD",8423,"KRN","B",779.2,779.2) "BLD",8423,"KRN","B",870,870) "BLD",8423,"KRN","B",8989.51,8989.51) "BLD",8423,"KRN","B",8989.52,8989.52) "BLD",8423,"KRN","B",8994,8994) "BLD",8423,"QUES",0) ^9.62^^ "BLD",8423,"REQB",0) ^9.611^^ "DATA",9001,1,0) DEFAULT^13^*,PATIENT^Y^666^^2290101^3120524^^99999^999^^^N "FIA",9001) ISI PT IMPORT TEMPLATE "FIA",9001,0) ^ISI(9001, "FIA",9001,0,0) 9001 "FIA",9001,0,1) y^y^f^^n^^y^o^n "FIA",9001,0,10) "FIA",9001,0,11) "FIA",9001,0,"RLRO") "FIA",9001,9001) 0 "KRN",19,14127,-1) 0^1 "KRN",19,14127,0) ISI DATA IMPORT^ISI DATA IMPORT^^B^^^^^^^^ "KRN",19,14127,1,0) ^19.06^1^1^3120831^^^ "KRN",19,14127,1,1,0) All ISI IMPORT RPC's "KRN",19,14127,"RPC",0) ^19.05P^11^11 "KRN",19,14127,"RPC",1,0) ISI IMPORT APPT "KRN",19,14127,"RPC",2,0) ISI IMPORT LAB "KRN",19,14127,"RPC",3,0) ISI IMPORT MED "KRN",19,14127,"RPC",4,0) ISI IMPORT ALLERGY "KRN",19,14127,"RPC",5,0) ISI IMPORT NOTE "KRN",19,14127,"RPC",6,0) ISI IMPORT PAT "KRN",19,14127,"RPC",7,0) ISI IMPORT PROB "KRN",19,14127,"RPC",8,0) ISI IMPORT VITALS "KRN",19,14127,"RPC",9,0) ISI IMPORT CONSULT "KRN",19,14127,"RPC",10,0) ISI IMPORT RAD ORDER "KRN",19,14127,"RPC",11,0) ISI IMPORT ICDFIND "KRN",19,14127,"U") ISI DATA IMPORT "KRN",8994,2370,-1) 0^2 "KRN",8994,2370,0) ISI IMPORT PAT^PNTIMPRT^ISIIMPR1^2^P^^^1 "KRN",8994,2370,1,0) ^^1^1^3120628^ "KRN",8994,2370,1,1,0) test "KRN",8994,2370,2,0) ^8994.02A^1^1 "KRN",8994,2370,2,1,0) MISC^2^^1^1 "KRN",8994,2370,2,1,1,0) ^^1^1^3120623^ "KRN",8994,2370,2,1,1,1,0) test "KRN",8994,2370,2,"B","MISC",1) "KRN",8994,2370,2,"PARAMSEQ",1,1) "KRN",8994,2382,-1) 0^1 "KRN",8994,2382,0) ISI IMPORT APPT^APPMAKE^ISIIMPR1^2^P^^^1 "KRN",8994,2382,1,0) ^^1^1^3120628^ "KRN",8994,2382,1,1,0) test "KRN",8994,2382,2,0) ^8994.02A^1^1 "KRN",8994,2382,2,1,0) MISC^2^^1^1 "KRN",8994,2382,2,1,1,0) ^^1^1^3120628^ "KRN",8994,2382,2,1,1,1,0) test "KRN",8994,2382,2,"B","MISC",1) "KRN",8994,2382,2,"PARAMSEQ",1,1) "KRN",8994,2382,3,0) ^^1^1^3120628^ "KRN",8994,2382,3,1,0) test "KRN",8994,2886,-1) 0^3 "KRN",8994,2886,0) ISI IMPORT PROB^PROBMAKE^ISIIMPR1^2^P^^^1 "KRN",8994,2886,1,0) ^^1^1^3120628^ "KRN",8994,2886,1,1,0) test "KRN",8994,2886,2,0) ^8994.02A^1^1 "KRN",8994,2886,2,1,0) MISC^2^^1^1 "KRN",8994,2886,2,"B","MISC",1) "KRN",8994,2886,2,"PARAMSEQ",1,1) "KRN",8994,2886,3,0) ^^1^1^3120628^ "KRN",8994,2886,3,1,0) ISIRESUL "KRN",8994,2887,-1) 0^4 "KRN",8994,2887,0) ISI IMPORT VITALS^VITMAKE^ISIIMPR1^2^P "KRN",8994,2887,1,0) ^^1^1^3120711^ "KRN",8994,2887,1,1,0) ISI IMPORT VITALS utility used to seed test data into systems "KRN",8994,2887,2,0) ^8994.02A^1^1 "KRN",8994,2887,2,1,0) MISC^2^^1^1 "KRN",8994,2887,2,1,1,0) ^^1^1^3120711^ "KRN",8994,2887,2,1,1,1,0) Input array (MISC) "KRN",8994,2887,2,"B","MISC",1) "KRN",8994,2887,2,"PARAMSEQ",1,1) "KRN",8994,2888,-1) 0^5 "KRN",8994,2888,0) ISI IMPORT ALLERGY^ALGMAKE^ISIIMPR2^2^P "KRN",8994,2888,2,0) ^8994.02A^1^1 "KRN",8994,2888,2,1,0) MISC^2^^1^1 "KRN",8994,2888,2,"B","MISC",1) "KRN",8994,2888,2,"PARAMSEQ",1,1) "KRN",8994,2889,-1) 0^6 "KRN",8994,2889,0) ISI IMPORT LAB^LABMAKE^ISIIMPR2^2^P "KRN",8994,2889,1,0) ^^1^1^3120719^ "KRN",8994,2889,1,1,0) ISI IMPORT LAB utility is only used to seed test data into demo systems "KRN",8994,2889,2,0) ^8994.02A^1^1 "KRN",8994,2889,2,1,0) MISC^2^^1^1 "KRN",8994,2889,2,1,1,0) ^^1^1^3120719^ "KRN",8994,2889,2,1,1,1,0) Input array (MISC) "KRN",8994,2889,2,"B","MISC",1) "KRN",8994,2889,2,"PARAMSEQ",1,1) "KRN",8994,2890,-1) 0^8 "KRN",8994,2890,0) ISI IMPORT NOTE^NOTEMAKE^ISIIMPR2^2^P "KRN",8994,2890,1,0) ^^1^1^3120815^ "KRN",8994,2890,1,1,0) Import progress notes "KRN",8994,2890,2,0) ^8994.02A^1^1 "KRN",8994,2890,2,1,0) MISC^2^^1^1 "KRN",8994,2890,2,"B","MISC",1) "KRN",8994,2890,2,"PARAMSEQ",1,1) "KRN",8994,2891,-1) 0^7 "KRN",8994,2891,0) ISI IMPORT MED^MEDMAKE^ISIIMPR2^2^P "KRN",8994,2891,2,0) ^8994.02A^1^1 "KRN",8994,2891,2,1,0) MISC^2^^1^1 "KRN",8994,2891,2,"B","MISC",1) "KRN",8994,2891,2,"PARAMSEQ",1,1) "KRN",8994,2892,-1) 0^10 "KRN",8994,2892,0) ISI IMPORT TABLEFETCH^TABLEGET^ISIIMPR2^2^P "KRN",8994,2892,2,0) ^8994.02A^1^1 "KRN",8994,2892,2,1,0) TABLE^1^^1^1 "KRN",8994,2892,2,"B","TABLE",1) "KRN",8994,2892,2,"PARAMSEQ",1,1) "KRN",8994,2893,-1) 0^9 "KRN",8994,2893,0) ISI IMPORT CONSULT^CONMAKE^ISIIMPR2^2^P "KRN",8994,2893,2,0) ^8994.02A^1^1 "KRN",8994,2893,2,1,0) MISC^2^^1^1 "KRN",8994,2893,2,"B","MISC",1) "KRN",8994,2893,2,"PARAMSEQ",1,1) "KRN",8994,2894,-1) 0^11 "KRN",8994,2894,0) ISI IMPORT RAD ORDER^RADOMAKE^ISIIMPR1^2^P "KRN",8994,2894,2,0) ^8994.02A^1^1 "KRN",8994,2894,2,1,0) MISC^2^^1^1 "KRN",8994,2894,2,"B","MISC",1) "KRN",8994,2894,2,"PARAMSEQ",1,1) "KRN",8994,2895,-1) 0^12 "KRN",8994,2895,0) ISI IMPORT ICDFIND^ICD9GET^ISIIMPR2^2^P "KRN",8994,2895,1,0) ^^1^1^3120906^ "KRN",8994,2895,1,1,0) Peforms search for ICD9 expressions found in #757.01 "KRN",8994,2895,2,0) ^8994.02A^1^1 "KRN",8994,2895,2,1,0) TXT^1^^1^1 "KRN",8994,2895,2,1,1,0) ^^1^1^3120906^ "KRN",8994,2895,2,1,1,1,0) Pass string to check against possible matches. "KRN",8994,2895,2,"B","TXT",1) "KRN",8994,2895,2,"PARAMSEQ",1,1) "KRN",8994,2895,3,0) ^^1^1^3120906^ "KRN",8994,2895,3,1,0) Array of possible matches. "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 44 "RTN","ISIIMP") 0^1^B19105 "RTN","ISIIMP",1,0) ISIIMP ;ISI GROUP/MLS -- VistA DATA LOADER 1.0 ;6/26/12 "RTN","ISIIMP",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP",3,0) ; "RTN","ISIIMP",4,0) ; VistA Data Loader 1.0 "RTN","ISIIMP",5,0) ; "RTN","ISIIMP",6,0) ; Copyright (C) 2012 Johns Hopkins University "RTN","ISIIMP",7,0) ; "RTN","ISIIMP",8,0) ; VistA Data Loader is provided by the Johns Hopkins University School of "RTN","ISIIMP",9,0) ; Nursing, and funded by the Department of Health and Human Services, Office "RTN","ISIIMP",10,0) ; of the National Coordinator for Health Information Technology under Award "RTN","ISIIMP",11,0) ; Number #1U24OC000013-01. "RTN","ISIIMP",12,0) ; "RTN","ISIIMP",13,0) ; All portions of this release that are modified from the original Freedom "RTN","ISIIMP",14,0) ; of Information Act release provided by the Department of Veterans Affairs "RTN","ISIIMP",15,0) ; is subject to the terms of the GNU Affero General Public License as published "RTN","ISIIMP",16,0) ; by the Free Software Foundation, either version 3 of the License, or any "RTN","ISIIMP",17,0) ; later version. "RTN","ISIIMP",18,0) ; "RTN","ISIIMP",19,0) ; This program is distributed in the hope that it will be useful, but WITHOUT "RTN","ISIIMP",20,0) ; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS "RTN","ISIIMP",21,0) ; FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more "RTN","ISIIMP",22,0) ; details. "RTN","ISIIMP",23,0) ; "RTN","ISIIMP",24,0) ; You should have received a copy of the GNU Affero General Public License "RTN","ISIIMP",25,0) ; along with this program. If not, see http://www.gnu.org/licenses/. "RTN","ISIIMP",26,0) ; "RTN","ISIIMP",27,0) ; "RTN","ISIIMP",28,0) ; DECLARATIONS "RTN","ISIIMP",29,0) ; ------------------------------- "RTN","ISIIMP",30,0) ; This software package is NOT for use in any production or clinical setting. "RTN","ISIIMP",31,0) ; The software has not been designed, coded, or tested for use in any clinical "RTN","ISIIMP",32,0) ; or production setting. "RTN","ISIIMP",33,0) ; "RTN","ISIIMP",34,0) ; This should be considered a work in progress. If folks are interested in "RTN","ISIIMP",35,0) ; collaborating on a 2.0 version of the utility set should please contact "RTN","ISIIMP",36,0) ; Mike Stark (starklogic@gmail.com) or ISI GROUP, LLC, Bethesda, MD. "RTN","ISIIMP",37,0) ; "RTN","ISIIMP",38,0) ; "RTN","ISIIMP",39,0) ; CREDITS "RTN","ISIIMP",40,0) ; ------------ "RTN","ISIIMP",41,0) ; Some of the utilities used inside this package were first used inside the "RTN","ISIIMP",42,0) ; "CAMP MASTER" VistA training system used at the VA's VEHU conference "RTN","ISIIMP",43,0) ; (available through FOIA). These are not "production" utilities and are "RTN","ISIIMP",44,0) ; not properly attributed to their authors. Most of them were coded by "RTN","ISIIMP",45,0) ; by folks in their spare time out of generosity and dedication to the "RTN","ISIIMP",46,0) ; VA's mission. "RTN","ISIIMP",47,0) ; "RTN","ISIIMP",48,0) ; Where it is not possible to properly give credit, I apologize. Below is a "RTN","ISIIMP",49,0) ; list of routines borrowed from and their author initials. I'm listing them "RTN","ISIIMP",50,0) ; here for proper credit -- all mistakes & bugs are my own (see DECLARATIONS "RTN","ISIIMP",51,0) ; AND CAVEATS above). "RTN","ISIIMP",52,0) ; "RTN","ISIIMP",53,0) ; LAB utility (LRZORD,LRZORD1,LRZOE,LRZOE2,LRZVER*): DALOI/CJS, NTEO/JFR "RTN","ISIIMP",54,0) ; VITAL utility (ZGMRVPOP): SLC/DAN "RTN","ISIIMP",55,0) ; PATIENT utility (ZVHDPT): DALOI/RM "RTN","ISIIMP",56,0) ; PROBLEM utility (ZVHGMPL): NTEO/JFR "RTN","ISIIMP",57,0) ; APPOINTMENTS utility (ZVHZSDM): SLC/DAN "RTN","ISIIMP",58,0) ; "RTN","ISIIMP",59,0) ; "RTN","ISIIMP",60,0) ; GENERAL OPERATION "RTN","ISIIMP",61,0) ; ----------------- "RTN","ISIIMP",62,0) ; 1) Receive input list, MISC, from RPC ^ISIIMPR*. "RTN","ISIIMP",63,0) ; 2) Convert list, MISC, to usable array, ISIMISC, in utility ^ISIIMPU*. "RTN","ISIIMP",64,0) ; 3) Perform validation on array, ISIMISC, in ^ISIIMPU*. "RTN","ISIIMP",65,0) ; 4) Perform import via API in ^ISIIMP##. "RTN","ISIIMP",66,0) ; "RTN","ISIIMP",67,0) ; "RTN","ISIIMP",68,0) ; NAMESPACING -- FUNCTION "RTN","ISIIMP",69,0) ; ------------------------ "RTN","ISIIMP",70,0) ; ISIIMP* -- All DATA Loader routines "RTN","ISIIMP",71,0) ; ISIIMPR* -- RPC entry points "RTN","ISIIMP",72,0) ; ISIIMPU* -- Utilities (merge, validation, etc.) "RTN","ISIIMP",73,0) ; ISIIMP## -- API entry, create, and rpc handlers "RTN","ISIIMP",74,0) ; ISIIMPER -- Error processing "RTN","ISIIMP",75,0) ; ISIIMPL* -- Lab import spill over routines "RTN","ISIIMP",76,0) ; "RTN","ISIIMP",77,0) ; "RTN","ISIIMP",78,0) ; API ENTRY POINT ------ DESCRIPTION "RTN","ISIIMP",79,0) ; ------------------------------------------- "RTN","ISIIMP",80,0) ; IMPORTPT^ISIIMP03 ----- Patient import API "RTN","ISIIMP",81,0) ; APPT^ISIIMP05 ----- Appointment Import API "RTN","ISIIMP",82,0) ; CREATE^ISIIMP07 ----- Problem Import API "RTN","ISIIMP",83,0) ; IMPORTVT^ISIIMP09 ----- Vitals Import API "RTN","ISIIMP",84,0) ; IMPRTALG^ISIIMP11 ----- Allergy Import API "RTN","ISIIMP",85,0) ; IMPRTLAB^ISIIMP13 ----- LABS Import API "RTN","ISIIMP",86,0) ; IMPRTNOT^ISIIMP15 ----- Notes Import API "RTN","ISIIMP",87,0) ; MEDS^ISIIMP17 ----- Med Import API "RTN","ISIIMP",88,0) ; CONS^ISIIMP19 ----- Consults Import API "RTN","ISIIMP",89,0) ; RADO^ISIIMP21 ----- RAD ORDERS Import API "RTN","ISIIMP",90,0) ; ENTRY^ISIIMPUA ----- File fetch for external select lists "RTN","ISIIMP",91,0) ; ICD9^ISIIMPUA ----- Fetches ICD description "RTN","ISIIMP",92,0) ; "RTN","ISIIMP",93,0) ; "RTN","ISIIMP",94,0) ; REMOTE PROCEDURE ENTRY POINT DESCRIPTION "RTN","ISIIMP",95,0) ; ----------------------------------------------------------------------- "RTN","ISIIMP",96,0) ; ISI IMPORT ALLERGY ALGMAKE^ISIIMPR2 Load allergy entries "RTN","ISIIMP",97,0) ; ISI IMPORT APPT APPMAKE^ISIIMPR1 Load appt and encounters "RTN","ISIIMP",98,0) ; ISI IMPORT CONSULT CONMAKE^ISIIMPR2 Creates and sign consults "RTN","ISIIMP",99,0) ; ISI IMPORT ICDFIND ICD9GET^ISIIMPR2 Fetches ICD9 Descriptions "RTN","ISIIMP",100,0) ; ISI IMPORT LAB LABMAKE^ISIIMPR2 Creates Lab tests "RTN","ISIIMP",101,0) ; ISI IMPORT MED MEDMAKE^ISIIMPR2 Creates Medication orders "RTN","ISIIMP",102,0) ; ISI IMPORT NOTE NOTEMAKE^ISIIMPR2 Creates TIU/Progress note entries "RTN","ISIIMP",103,0) ; ISI IMPORT PAT PNTIMPORT^ISIIMPR1 Creates patient records "RTN","ISIIMP",104,0) ; ISI IMPORT PROB PROBMAKE^ISIIMPR1 Creates Problem entries "RTN","ISIIMP",105,0) ; ISI IMPORT RAD ORDER RADOMAKE^ISIIMPR1 Creates Radiology order entries "RTN","ISIIMP",106,0) ; ISI IMPORT TABLEFETCH TABLEGET^ISIIMPR2 Exports select tables "RTN","ISIIMP",107,0) ; "RTN","ISIIMP",108,0) ; "RTN","ISIIMP",109,0) ; Validation entry -- Description "RTN","ISIIMP",110,0) ; ----------------------------------- "RTN","ISIIMP",111,0) ; VALIDATE^ISIIMPU1 -- Patient import validation "RTN","ISIIMP",112,0) ; VALAPT^ISIIMPU2 -- Appointment import validation "RTN","ISIIMP",113,0) ; VALPROB^ISIIMPU4 -- Problem import validation "RTN","ISIIMP",114,0) ; VALVITAL^ISIIMPU5 -- Vitals import validation "RTN","ISIIMP",115,0) ; VALALG^ISIIMPU6 -- Allergy import validation "RTN","ISIIMP",116,0) ; VALLAB^ISIIMPU7 -- Labs import validation "RTN","ISIIMP",117,0) ; VALNOTE^ISIIMPU8 -- Notes import validation "RTN","ISIIMP",118,0) ; VALMEDS^ISIIMPU9 -- Meds import validation "RTN","ISIIMP",119,0) ; VALCONS^ISIIMPUB -- Consult import validation "RTN","ISIIMP",120,0) ; VALRADO^ISIIMPUC -- Rad Orders Import validation "RTN","ISIIMP",121,0) ; "RTN","ISIIMP",122,0) ; "RTN","ISIIMP",123,0) ; Lab import spill over routines "RTN","ISIIMP",124,0) ; ------------------------------ "RTN","ISIIMP",125,0) ; ISIIMPL1 "RTN","ISIIMP",126,0) ; ISIIMPL2 "RTN","ISIIMP",127,0) ; ISIIMPL3 "RTN","ISIIMP",128,0) ; ISIIMPL4 "RTN","ISIIMP",129,0) ; "RTN","ISIIMP",130,0) ; "RTN","ISIIMP",131,0) ; ISI PT IMPORT TEMPLATE (#9001) "RTN","ISIIMP",132,0) ; ------------------------------ "RTN","ISIIMP",133,0) ; 9001,.01 NAME 0;1 FREE TEXT (Required) "RTN","ISIIMP",134,0) ; 9001,1 TYPE 0;2 POINTER TO TYPE OF PATIENT FILE (#391) "RTN","ISIIMP",135,0) ; 9001,2 NAME MASK 0;3 FREE TEXT "RTN","ISIIMP",136,0) ; 9001,4 SSN MASK 0;5 NUMBER "RTN","ISIIMP",137,0) ; 9001,5 SEX 0;6 SET "RTN","ISIIMP",138,0) ; 9001,6 EARLIEST DATE OF BIRTH 0;7 DATE "RTN","ISIIMP",139,0) ; 9001,7 LATEST DATE OF BIRTH 0;8 DATE "RTN","ISIIMP",140,0) ; 9001,8 MARITAL STATUS 0;9 POINTER TO MARITAL STATUS FILE (#11) "RTN","ISIIMP",141,0) ; 9001,9 ZIP+4 MASK 0;10 NUMBER "RTN","ISIIMP",142,0) ; 9001,10 PHONE NUMBER [RESIDENCE] MASK 0;11 NUMBER "RTN","ISIIMP",143,0) ; 9001,11 CITY 0;12 FREE TEXT "RTN","ISIIMP",144,0) ; 9001,12 STATE 0;13 POINTER TO STATE FILE (#5) "RTN","ISIIMP",145,0) ; 9001,13 VETERAN 0;14 SET "RTN","ISIIMP",146,0) ; 9001,14 DFN_NAME 0;4 SET "RTN","ISIIMP",147,0) ; 9001,15 EMPLOYMENT STATUS 0;15 SET "RTN","ISIIMP",148,0) ; "RTN","ISIIMP",149,0) Q "RTN","ISIIMP02") 0^2^B376381 "RTN","ISIIMP02",1,0) ISIIMP02 ;ISI GROUP/MLS -- IMPORT PATIENT INFORMATION API "RTN","ISIIMP02",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP02",3,0) Q "RTN","ISIIMP02",4,0) PATIENT(ISIRESUL,ISIMISC) "RTN","ISIIMP02",5,0) N ERR,VAL "RTN","ISIIMP02",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP02",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP02",8,0) ; "RTN","ISIIMP02",9,0) ;Validate setup & parameters "RTN","ISIIMP02",10,0) S ISIRC=$$VALIDATE^ISIIMP03 Q:+ISIRC<0 ISIRC "RTN","ISIIMP02",11,0) ;Create patient record "RTN","ISIIMP02",12,0) S ISIRC=$$CREATEPTS^ISIIMP03 Q:+ISIRC<0 ISIRC "RTN","ISIIMP02",13,0) ; Quit with DFN "RTN","ISIIMP02",14,0) Q ISIRC "RTN","ISIIMP03") 0^3^B608470 "RTN","ISIIMP03",1,0) ISIIMP03 ;ISI GROUP/MLS -- PATIENT IMPORT CONT. "RTN","ISIIMP03",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP03",3,0) Q "RTN","ISIIMP03",4,0) ; "RTN","ISIIMP03",5,0) VALIDATE() ; "RTN","ISIIMP03",6,0) ; "RTN","ISIIMP03",7,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP03",8,0) . W !,"+++Template merged params+++",! "RTN","ISIIMP03",9,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,X," ",$G(ISIMISC(X)) "RTN","ISIIMP03",10,0) . W !,"" R X "RTN","ISIIMP03",11,0) . Q "RTN","ISIIMP03",12,0) ; "RTN","ISIIMP03",13,0) ; Validate import array contents "RTN","ISIIMP03",14,0) S ISIRC=$$VALIDATE^ISIIMPU1(.ISIMISC) "RTN","ISIIMP03",15,0) Q ISIRC "RTN","ISIIMP03",16,0) ; "RTN","ISIIMP03",17,0) CREATEPTS() ; "RTN","ISIIMP03",18,0) ; Create patient(s) "RTN","ISIIMP03",19,0) S ISIRC=$$IMPORTPT(.ISIMISC) "RTN","ISIIMP03",20,0) Q ISIRC "RTN","ISIIMP03",21,0) ; "RTN","ISIIMP03",22,0) IMPORTPT(ISIMISC) "RTN","ISIIMP03",23,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP03",24,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP03",25,0) ; eg: ISIMISC("NAME")="FIRST,LAST" "RTN","ISIIMP03",26,0) ; "RTN","ISIIMP03",27,0) ; Output - ISIRC [return code] "RTN","ISIIMP03",28,0) ; ISIRESUL(0) = CNT "RTN","ISIIMP03",29,0) ; ISIRESUL(1) = DFN^SSN^NAME "RTN","ISIIMP03",30,0) ; "RTN","ISIIMP03",31,0) I ISIMISC("IMP_TYPE")="B" D BATCH "RTN","ISIIMP03",32,0) I ISIMISC("IMP_TYPE")="I" D INDIVIDUAL "RTN","ISIIMP03",33,0) Q ISIRC "RTN","ISIIMP03",34,0) ; "RTN","ISIIMP03",35,0) INDIVIDUAL "RTN","ISIIMP03",36,0) N SSN,SSNMASK,RETURN,STRTSSN,ENDSSN,NUM,INCR "RTN","ISIIMP03",37,0) N NAME,SEX,DOB,STRT1,STRT2,CITY,STATE,ZIP,MARSTAT,PHON,VETERAN "RTN","ISIIMP03",38,0) N RACE,ETHN,INSUR,OCCUP,EMPLOY "RTN","ISIIMP03",39,0) ; "RTN","ISIIMP03",40,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP03",41,0) . W !,"+++Starting Individual PT Create+++",! "RTN","ISIIMP03",42,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,X," ",$G(ISIMISC(X)) "RTN","ISIIMP03",43,0) . W !,"" R X:5 "RTN","ISIIMP03",44,0) . Q "RTN","ISIIMP03",45,0) ; "RTN","ISIIMP03",46,0) S ISIRC=0,INCR=1 "RTN","ISIIMP03",47,0) S SSN=$G(ISIMISC("SSN")) "RTN","ISIIMP03",48,0) I SSN'="" D Q "RTN","ISIIMP03",49,0) . I $D(^DPT("SSN",SSN)) S ISIRC="-1^Duplicate SSN" Q "RTN","ISIIMP03",50,0) . S STRTSSN="9"_SSN "RTN","ISIIMP03",51,0) . D PREPVAL I +ISIRC<0 Q "RTN","ISIIMP03",52,0) . D CREATEPNT "RTN","ISIIMP03",53,0) . Q "RTN","ISIIMP03",54,0) I SSN="" D "RTN","ISIIMP03",55,0) . S SSNMASK=$G(ISIMISC("SSN_MASK")) "RTN","ISIIMP03",56,0) . I SSNMASK="" S SSNMASK="000" "RTN","ISIIMP03",57,0) . S RETURN=$$EVALSSNMASK(SSNMASK) "RTN","ISIIMP03",58,0) . I (+RETURN)<1 S SSNMASK="666" S RETURN=$$EVALSSNMASK(SSNMASK) "RTN","ISIIMP03",59,0) . I (+RETURN)<1 S ISIRC="-1^Error: unable to create SSN (ISIIMP03)" Q ; We've run out of non-standard SSN's! Time to refresh your database. "RTN","ISIIMP03",60,0) . S STRTSSN="9"_$P(RETURN,"|",2),ENDSSN="9"_$P(RETURN,"|",3) "RTN","ISIIMP03",61,0) . F Q:'$D(^DPT("SSN",$E(STRTSSN,2,10))) S STRTSSN=STRTSSN+1 "RTN","ISIIMP03",62,0) . I STRTSSN>ENDSSN S ISIRC="-1^Problem generating SSN" Q "RTN","ISIIMP03",63,0) . S SSN=$E(STRTSSN,2,10) "RTN","ISIIMP03",64,0) . D PREPVAL I +ISIRC<0 Q ;in case of error "RTN","ISIIMP03",65,0) . D CREATEPNT "RTN","ISIIMP03",66,0) . Q "RTN","ISIIMP03",67,0) Q "RTN","ISIIMP03",68,0) ; "RTN","ISIIMP03",69,0) BATCH ; "RTN","ISIIMP03",70,0) N INCR,I,NUM,RETURN,SSNMASK,SSN,STRTSSN,ENDSSN,EXIT "RTN","ISIIMP03",71,0) N NAME,SEX,DOB,STRT1,STRT2,CITY,STATE,ZIP,MARSTAT,PHON,VETERAN "RTN","ISIIMP03",72,0) N RACE,ETHN,INSUR,OCCUP,EMPLOY "RTN","ISIIMP03",73,0) ; "RTN","ISIIMP03",74,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP03",75,0) . W !,"+++Starting Batch PT Creation+++",! "RTN","ISIIMP03",76,0) . I $D(ISIMISC) W $G(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,ISIMISC(X) "RTN","ISIIMP03",77,0) . W !,"" R X:5 "RTN","ISIIMP03",78,0) . Q "RTN","ISIIMP03",79,0) ; "RTN","ISIIMP03",80,0) S EXIT=0,ISIRC=0 "RTN","ISIIMP03",81,0) S NUM=$G(ISIMISC("IMP_BATCH_NUM")) "RTN","ISIIMP03",82,0) S SSNMASK=$G(ISIMISC("SSN_MASK")) "RTN","ISIIMP03",83,0) S RETURN=$$EVALSSNMASK(SSNMASK) "RTN","ISIIMP03",84,0) I (+RETURN)ENDSSN S EXIT=1,ISIRC="-1^Problem generating SSNs" Q "RTN","ISIIMP03",89,0) . S SSN=$E(STRTSSN,2,10) "RTN","ISIIMP03",90,0) . D PREPVAL I +ISIRC<0 S EXIT=1 Q "RTN","ISIIMP03",91,0) . D CREATEPNT "RTN","ISIIMP03",92,0) . I +ISIRC<0 S EXIT=1 Q "RTN","ISIIMP03",93,0) . Q "RTN","ISIIMP03",94,0) Q "RTN","ISIIMP03",95,0) PREPVAL ;Prep import values "RTN","ISIIMP03",96,0) N LDOB,UDOB "RTN","ISIIMP03",97,0) S (NAME,SEX,DOB,STRT1,STRT2,CITY,STATE,ZIP,MARSTAT,PHON,VETERAN,TYPE,RACE,ETHN,INSUR,OCCUP,EMPLOY)="" "RTN","ISIIMP03",98,0) S NAME=$G(ISIMISC("NAME")) I NAME="" S NAME=$$MASK("NAME",$G(ISIMISC("NAME_MASK")),INCR) "RTN","ISIIMP03",99,0) S SEX=$G(ISIMISC("SEX")) "RTN","ISIIMP03",100,0) I SEX="" S SEX=$$SEX "RTN","ISIIMP03",101,0) S DOB=$G(ISIMISC("DOB")) I DOB="" S LDOB=$G(ISIMISC("LOW_DOB")),UDOB=$G(ISIMISC("UP_DOB")) S DOB=$$DOB "RTN","ISIIMP03",102,0) S STRT1=$G(ISIMISC("STREET_ADD1")) "RTN","ISIIMP03",103,0) I STRT1="" S STRT1=$$STREET "RTN","ISIIMP03",104,0) S STRT2=$G(ISIMISC("STREET_ADD2")) "RTN","ISIIMP03",105,0) S CITY=$G(ISIMISC("CITY")) I CITY="" S CITY=$$CITY "RTN","ISIIMP03",106,0) S STATE=$G(ISIMISC("STATE")) I STATE="" S STATE=$$STATE "RTN","ISIIMP03",107,0) S ZIP=$G(ISIMISC("ZIP")) I ZIP="" S ZIP=$$MASK("ZIP",$G(ISIMISC("ZIP_4_MASK"))) "RTN","ISIIMP03",108,0) S MARSTAT=$G(ISIMISC("MARITAL_STATUS")) I MARSTAT="" S MARSTAT=$$MARSTAT "RTN","ISIIMP03",109,0) S PHON=$G(ISIMISC("PH_NUM")) I PHON="" S PHON=$$MASK("PHONE",$G(ISIMISC("PH_NUM_MASK"))) "RTN","ISIIMP03",110,0) S VETERAN=$G(ISIMISC("VETERAN")) I VETERAN="" S VETERAN="N" "RTN","ISIIMP03",111,0) S TYPE=$G(ISIMISC("TYPE")) I TYPE="" S TYPE="NON-VETERAN (OTHER)" "RTN","ISIIMP03",112,0) S RACE=$G(ISIMISC("RACE")) "RTN","ISIIMP03",113,0) S ETHN=$G(ISIMISC("ETHNICITY")) "RTN","ISIIMP03",114,0) S INSUR=$G(ISIMISC("INSUR_TYPE")) "RTN","ISIIMP03",115,0) S OCCUP=$G(ISIMISC("OCCUPATION")) "RTN","ISIIMP03",116,0) S EMPLOY=$G(ISIMISC("EMPLOY_STAT")) "RTN","ISIIMP03",117,0) Q "RTN","ISIIMP03",118,0) CREATEPNT ; "RTN","ISIIMP03",119,0) N FDA,MSG "RTN","ISIIMP03",120,0) K FDA "RTN","ISIIMP03",121,0) D "RTN","ISIIMP03",122,0) . S FDA(2,"+1,",.01)=NAME "RTN","ISIIMP03",123,0) . S FDA(2,"+1,",.02)=SEX "RTN","ISIIMP03",124,0) . S FDA(2,"+1,",.03)=DOB "RTN","ISIIMP03",125,0) . S FDA(2,"+1,",.05)=MARSTAT "RTN","ISIIMP03",126,0) . I $G(OCCUP)'="" S FDA(2,"+1,",.07)=OCCUP "RTN","ISIIMP03",127,0) . S FDA(2,"+1,",.09)=SSN "RTN","ISIIMP03",128,0) . ;S FDA(2,"+1,",400000000)=SSN ;NATIONAL ID field used in EHR "RTN","ISIIMP03",129,0) . S FDA(2,"+1,",.111)=STRT1 "RTN","ISIIMP03",130,0) . S FDA(2,"+1,",.112)=STRT2 "RTN","ISIIMP03",131,0) . S FDA(2,"+1,",.114)=CITY "RTN","ISIIMP03",132,0) . S FDA(2,"+1,",.115)=STATE "RTN","ISIIMP03",133,0) . S FDA(2,"+1,",.1112)=ZIP "RTN","ISIIMP03",134,0) . S FDA(2,"+1,",.131)=PHON "RTN","ISIIMP03",135,0) . S FDA(2,"+1,",391)=TYPE "RTN","ISIIMP03",136,0) . S FDA(2,"+1,",1901)=VETERAN "RTN","ISIIMP03",137,0) . S FDA(2,"+1,",.12105)="N" ; TEMPORARY ADD ACTIVE "RTN","ISIIMP03",138,0) . S FDA(2,"+1,",.14105)="N" ; CONFIDENTIAL ADD ACTIVE "RTN","ISIIMP03",139,0) . S FDA(2,"+1,",.2125)="N" ; K-ADD SAME AS PNT'S "RTN","ISIIMP03",140,0) . S FDA(2,"+1,",.21925)="N" ; K2-ADD SAME AS PNT'S "RTN","ISIIMP03",141,0) . S FDA(2,"+1,",.2515)="1" ; SPOUSE EMPLOYMENT STATUS "RTN","ISIIMP03",142,0) . S FDA(2,"+1,",.301)="N" ; SERVICE CONNECTED "RTN","ISIIMP03",143,0) . I $G(EMPLOY)'="" S FDA(2,"+1,",.31115)=EMPLOY "RTN","ISIIMP03",144,0) . E S FDA(2,"+1,",.31115)="1" ; EMPLOYMENT STATUS "RTN","ISIIMP03",145,0) . S FDA(2,"+1,",.3192)="Y" ; COVERED BY HEALTH INSURANCE "RTN","ISIIMP03",146,0) . S FDA(2,"+1,",.32101)="Y" ; VIETNAM SERVICE INDICATED "RTN","ISIIMP03",147,0) . S FDA(2,"+1,",.32102)="N" ; AGENT ORANGE EXPOS. INDICATED "RTN","ISIIMP03",148,0) . S FDA(2,"+1,",.32103)="N" ; RADIATION EXPOSURE INDICATED "RTN","ISIIMP03",149,0) . S FDA(2,"+1,",.32201)="N" ; PERSIAN GULF SERVICE "RTN","ISIIMP03",150,0) . S FDA(2,"+1,",.322013)="N" ; ENVIRONMENTAL CONTAMINANTS "RTN","ISIIMP03",151,0) . S FDA(2,"+1,",.322016)="N" ; SOMALIA SERVICE INDICATED "RTN","ISIIMP03",152,0) . S FDA(2,"+1,",.3221)="N" ; LEBANON SERVICE INDICATED "RTN","ISIIMP03",153,0) . S FDA(2,"+1,",.3224)="N" ; GRENEDA SERVICE INDICATED "RTN","ISIIMP03",154,0) . S FDA(2,"+1,",.3227)="N" ; PANAMA SERVICE INDICATED "RTN","ISIIMP03",155,0) . S FDA(2,"+1,",.3285)="N" ; SERVICE SECOND EPISODE "RTN","ISIIMP03",156,0) . S FDA(2,"+1,",.32945)="N" ; SERVICE THIRD EPISODE "RTN","ISIIMP03",157,0) . S FDA(2,"+1,",.3305)="Y" ; E-EMER. CONTACT SAME AS NOK "RTN","ISIIMP03",158,0) . S FDA(2,"+1,",.3405)="Y" ; D-DESIGNEE SAME AS NOK "RTN","ISIIMP03",159,0) . S FDA(2,"+1,",.362)="0" ; DISABILITY RET. FROM MILITARY "RTN","ISIIMP03",160,0) . S FDA(2,"+1,",.381)="0" ; ELIGIBLE FOR MEDICAID "RTN","ISIIMP03",161,0) . S FDA(2,"+1,",.382)="T-"_($R(100)+1) ; DATE MEDICAID LAST ASKED "RTN","ISIIMP03",162,0) . S FDA(2,"+1,",.525)="N" ; POW STATUS INDICATED "RTN","ISIIMP03",163,0) . S FDA(2,"+1,",.5291)="N" ; COMBAT SERVICE INDICATED "RTN","ISIIMP03",164,0) . S FDA(2,"+1,",401.4)="T-"_($R(100)+1) ;DATE ENTERED ON SI LIST "RTN","ISIIMP03",165,0) . S FDA(2,"+1,",1010.15)="Y" ; RECIEVED VA CARE PREVIOUSLY "RTN","ISIIMP03",166,0) . S FDA(2,"+1,",994)="N" ; MULTIPLE BIRTH INDICATOR "RTN","ISIIMP03",167,0) . ;S FDA(2.03,"+1,+1,",.01)=$P(DATA,"^",6) "RTN","ISIIMP03",168,0) . I RACE'="" D "RTN","ISIIMP03",169,0) . . S FDA(2.02,"+2,+1,",.01)=RACE "RTN","ISIIMP03",170,0) . . S FDA(2.02,"+2,+1,",.02)="S" "RTN","ISIIMP03",171,0) . I ETHN'="" D "RTN","ISIIMP03",172,0) . . S FDA(2.06,"+3,+1,",.01)=ETHN "RTN","ISIIMP03",173,0) . . S FDA(2.06,"+3,+1,",.02)="S" "RTN","ISIIMP03",174,0) . I INSUR'="" D "RTN","ISIIMP03",175,0) . . S FDA(2.312,"+4,+1,",.01)=INSUR "RTN","ISIIMP03",176,0) . D UPDATE^DIE("E","FDA",,"MSG") "RTN","ISIIMP03",177,0) . I $D(MSG) S ISIRC="-1^"_$G(MSG("DIERR",1,"TEXT",1)) Q "RTN","ISIIMP03",178,0) . ; "RTN","ISIIMP03",179,0) . I '$D(^DPT("SSN",$E(STRTSSN,2,10))) S ISIRC="-1^Problem generating pt." Q "RTN","ISIIMP03",180,0) . I $G(ISIMISC("DFN_NAME"))="Y" I $G(ISIMISC("NAME_MASK"))'="" I $G(ISIMISC("NAME"))="" D "RTN","ISIIMP03",181,0) . . S NAME=$$MASK("NAME",$G(ISIMISC("NAME_MASK")),$O(^DPT("SSN",$E(STRTSSN,2,10),""))) "RTN","ISIIMP03",182,0) . . S ISIRC=$$CHNGNAME^ISIIMPU3($O(^DPT("SSN",$E(STRTSSN,2,10),"")),NAME) "RTN","ISIIMP03",183,0) . . Q "RTN","ISIIMP03",184,0) . I +ISIRC<0 Q "RTN","ISIIMP03",185,0) . S ISIRESUL(INCR)=DFN_"^"_$E(STRTSSN,2,10)_"^"_NAME "RTN","ISIIMP03",186,0) . S ISIRESUL(0)=INCR "RTN","ISIIMP03",187,0) . Q "RTN","ISIIMP03",188,0) Q "RTN","ISIIMP03",189,0) ;Q ISIRC "RTN","ISIIMP03",190,0) ; "RTN","ISIIMP03",191,0) MASK(TYPE,VALUE,INCR) "RTN","ISIIMP03",192,0) N X,L,I,CNT,NUMCONV "RTN","ISIIMP03",193,0) I TYPE="ZIP" D "RTN","ISIIMP03",194,0) . I VALUE="" S VALUE="00000" "RTN","ISIIMP03",195,0) . S I="" F X=$L(VALUE)+1:1:9 S I=I_"9" "RTN","ISIIMP03",196,0) . S L=$L(I),I=$R(I)+1 F X=$L(I)+1:1:L S I="0"_I "RTN","ISIIMP03",197,0) . S RETURN=VALUE_I "RTN","ISIIMP03",198,0) . Q "RTN","ISIIMP03",199,0) I TYPE="PHONE" D "RTN","ISIIMP03",200,0) . I VALUE="" S VALUE="555555" "RTN","ISIIMP03",201,0) . S I="" F X=$L(VALUE)+1:1:10 S I=I_"9" "RTN","ISIIMP03",202,0) . S L=$L(I),I=$R(I)+1 F X=$L(I)+1:1:L S I="0"_I "RTN","ISIIMP03",203,0) . S RETURN=VALUE_I "RTN","ISIIMP03",204,0) . Q "RTN","ISIIMP03",205,0) I TYPE="NAME" D "RTN","ISIIMP03",206,0) . D NUMTBL "RTN","ISIIMP03",207,0) . S I="" F X=1:1:$L(INCR) S I=I_NUMCONV($E(INCR,X)) "RTN","ISIIMP03",208,0) . S L=I "RTN","ISIIMP03",209,0) . I VALUE="" S VALUE="*,PATIENT" "RTN","ISIIMP03",210,0) . F D Q:VALUE'["*" "RTN","ISIIMP03",211,0) . . F X=1:1:$L(VALUE) I $E(VALUE,X)="*" D Q "RTN","ISIIMP03",212,0) . . . S VALUE=$E(VALUE,0,(X-1))_L_$E(VALUE,(X+1),9999) "RTN","ISIIMP03",213,0) . . . Q "RTN","ISIIMP03",214,0) . . Q "RTN","ISIIMP03",215,0) . S RETURN=VALUE "RTN","ISIIMP03",216,0) . Q "RTN","ISIIMP03",217,0) Q RETURN "RTN","ISIIMP03",218,0) ; "RTN","ISIIMP03",219,0) EVALSSNMASK(VALUE) ; "RTN","ISIIMP03",220,0) N I,II,X,CNT "RTN","ISIIMP03",221,0) S I=VALUE F X=$L(VALUE)+1:1:9 S $E(I,X)="0" "RTN","ISIIMP03",222,0) S I="9"_I "RTN","ISIIMP03",223,0) S II=VALUE F X=$L(VALUE)+1:1:9 S $E(II,X)="9" "RTN","ISIIMP03",224,0) S II="9"_II "RTN","ISIIMP03",225,0) S CNT=0 F X=I:1:II I '$D(^DPT("SSN",$E(X,2,10))) S CNT=CNT+1 "RTN","ISIIMP03",226,0) S I=$E(I,2,10),II=$E(II,2,10) "RTN","ISIIMP03",227,0) Q CNT_"|"_I_"|"_II "RTN","ISIIMP03",228,0) ; "RTN","ISIIMP03",229,0) DOB() "RTN","ISIIMP03",230,0) N X,X1,X2,DIFF,TDAY,RESULT "RTN","ISIIMP03",231,0) D NOW^%DTC S TDAY=X "RTN","ISIIMP03",232,0) I $G(LDOB)'="" D "RTN","ISIIMP03",233,0) . D DT^DILF("E",LDOB,.RESULT) "RTN","ISIIMP03",234,0) . S LDOB=RESULT "RTN","ISIIMP03",235,0) I $G(LDOB)="" D ; Generate Lower limit for DOB "RTN","ISIIMP03",236,0) . S X1=TDAY,X2=-(365*90) D C^%DTC S LDOB=X Q "RTN","ISIIMP03",237,0) I $G(HDOB)="" D ; Generate Uppoer limit for DOB "RTN","ISIIMP03",238,0) . S X1=TDAY,X2=-(365*10) D C^%DTC S HDOB=X Q "RTN","ISIIMP03",239,0) ; Gererate random DOB between upper and lower limits "RTN","ISIIMP03",240,0) S X1=HDOB,X2=LDOB D ^%DTC S DIFF=X "RTN","ISIIMP03",241,0) S X1=LDOB S X2=$R(DIFF) D C^%DTC S DOB=X "RTN","ISIIMP03",242,0) Q DOB "RTN","ISIIMP03",243,0) ; "RTN","ISIIMP03",244,0) SEX() "RTN","ISIIMP03",245,0) N Y S Y=$R(2) S SEX=$S(Y=0:"F",1:"M") "RTN","ISIIMP03",246,0) Q SEX "RTN","ISIIMP03",247,0) ; "RTN","ISIIMP03",248,0) CITY() "RTN","ISIIMP03",249,0) N Y K Y "RTN","ISIIMP03",250,0) S Y(1)="ANYTOWN" "RTN","ISIIMP03",251,0) S Y(2)="SMALLVILLE" "RTN","ISIIMP03",252,0) S Y(3)="GOTHAM" "RTN","ISIIMP03",253,0) S Y(4)="CAPITOL CITY" "RTN","ISIIMP03",254,0) S Y(5)="WHOVILLE" "RTN","ISIIMP03",255,0) S Y(6)="METROPOLIS" "RTN","ISIIMP03",256,0) S Y(7)="SPRINGFIELD" "RTN","ISIIMP03",257,0) S Y(8)="ATLANTIS" "RTN","ISIIMP03",258,0) S Y(9)="VILLAGE" "RTN","ISIIMP03",259,0) S Y(10)="EMERALD CITY" "RTN","ISIIMP03",260,0) S Y(11)="CITY ON HILL" "RTN","ISIIMP03",261,0) S Y(12)="SHINING CITY" "RTN","ISIIMP03",262,0) S Y(13)="MOS EISELY" "RTN","ISIIMP03",263,0) S Y(14)="ZION" "RTN","ISIIMP03",264,0) S Y(15)="MAYBERRY" "RTN","ISIIMP03",265,0) S Y(16)="SUNNYDALE" "RTN","ISIIMP03",266,0) S Y(17)="SOUTH PARK" "RTN","ISIIMP03",267,0) S Y(18)="SIN CITY" "RTN","ISIIMP03",268,0) S Y(19)="BEDFORD FALLS" "RTN","ISIIMP03",269,0) S Y(20)="POTTERSVILLE" "RTN","ISIIMP03",270,0) S Y(21)="PLEASANTVILLE" "RTN","ISIIMP03",271,0) S Y(22)="ROCK RIDGE" "RTN","ISIIMP03",272,0) S Y(23)="BRIGADOON" "RTN","ISIIMP03",273,0) S Y=$R(23)+1 S CITY=Y(Y) "RTN","ISIIMP03",274,0) Q CITY "RTN","ISIIMP03",275,0) ; "RTN","ISIIMP03",276,0) STATE() "RTN","ISIIMP03",277,0) N R,Y,EXIT "RTN","ISIIMP03",278,0) S EXIT=0,R=$P(^DIC(5,0),"^",3) "RTN","ISIIMP03",279,0) F Q:EXIT S Y=$R(R)+1 I $P($G(^DIC(5,Y,0)),U)'="" I $P($G(^DIC(5,Y,0)),U,6)=1 S STATE=$P(^DIC(5,Y,0),U),EXIT=1 "RTN","ISIIMP03",280,0) Q STATE "RTN","ISIIMP03",281,0) ; "RTN","ISIIMP03",282,0) STREET() "RTN","ISIIMP03",283,0) N Y,YY "RTN","ISIIMP03",284,0) S Y(1)="LANE" "RTN","ISIIMP03",285,0) S Y(2)="STREET" "RTN","ISIIMP03",286,0) S Y(3)="ROAD" "RTN","ISIIMP03",287,0) S Y(4)="ALLEY" "RTN","ISIIMP03",288,0) S Y(5)="WAY" "RTN","ISIIMP03",289,0) S Y(6)="DRIVE" "RTN","ISIIMP03",290,0) S Y(7)="AVENUE" "RTN","ISIIMP03",291,0) S Y(8)="PARKWAY" "RTN","ISIIMP03",292,0) S Y(9)="COURT" "RTN","ISIIMP03",293,0) ; "RTN","ISIIMP03",294,0) S YY(1)="FIRST" "RTN","ISIIMP03",295,0) S YY(2)="SECOND" "RTN","ISIIMP03",296,0) S YY(3)="THIRD" "RTN","ISIIMP03",297,0) S YY(4)="FOURTH" "RTN","ISIIMP03",298,0) S YY(5)="FIFTH" "RTN","ISIIMP03",299,0) S YY(6)="SIXTH" "RTN","ISIIMP03",300,0) S YY(7)="SEVENTH" "RTN","ISIIMP03",301,0) S YY(8)="EIGHTH" "RTN","ISIIMP03",302,0) S YY(9)="NINTH" "RTN","ISIIMP03",303,0) ; "RTN","ISIIMP03",304,0) Q $R(1000)+1_" "_YY($R(7)+1)_" "_Y($R(9)+1) "RTN","ISIIMP03",305,0) ; "RTN","ISIIMP03",306,0) MARSTAT() "RTN","ISIIMP03",307,0) N R,Y,EXIT "RTN","ISIIMP03",308,0) S EXIT=0,R=$P(^DIC(11,0),"^",3) "RTN","ISIIMP03",309,0) F Q:EXIT S Y=$R(R)+1 I $P($G(^DIC(11,Y,0)),U)'="" S MARSTAT=$P(^DIC(11,Y,0),U),EXIT=1 "RTN","ISIIMP03",310,0) Q MARSTAT "RTN","ISIIMP03",311,0) ; "RTN","ISIIMP03",312,0) NUMTBL ; "RTN","ISIIMP03",313,0) S NUMCONV(1)="ONE" "RTN","ISIIMP03",314,0) S NUMCONV(2)="TWO" "RTN","ISIIMP03",315,0) S NUMCONV(3)="THREE" "RTN","ISIIMP03",316,0) S NUMCONV(4)="FOUR" "RTN","ISIIMP03",317,0) S NUMCONV(5)="FIVE" "RTN","ISIIMP03",318,0) S NUMCONV(6)="SIX" "RTN","ISIIMP03",319,0) S NUMCONV(7)="SEVEN" "RTN","ISIIMP03",320,0) S NUMCONV(8)="EIGHT" "RTN","ISIIMP03",321,0) S NUMCONV(9)="NINE" "RTN","ISIIMP03",322,0) S NUMCONV(0)="ZERO" "RTN","ISIIMP03",323,0) Q "RTN","ISIIMP04") 0^4^B390711 "RTN","ISIIMP04",1,0) ISIIMP04 ;ISI GROUP/MLS -- APPT API "RTN","ISIIMP04",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP04",3,0) Q "RTN","ISIIMP04",4,0) APPOINT() ; "RTN","ISIIMP04",5,0) N ERR,VAL,ADATE,SC,DFN "RTN","ISIIMP04",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP04",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP04",8,0) ; "RTN","ISIIMP04",9,0) ;Validate input array "RTN","ISIIMP04",10,0) S ISIRC=$$VALIDATE^ISIIMP05 Q:+ISIRC<0 ISIRC "RTN","ISIIMP04",11,0) ;Create Appointment "RTN","ISIIMP04",12,0) S ISIRC=$$MAKEAPPT^ISIIMP05 Q:+ISIRC<0 ISIRC "RTN","ISIIMP04",13,0) S ISIRESUL(0)=ISIRC "RTN","ISIIMP04",14,0) ; "RTN","ISIIMP04",15,0) Q ISIRC "RTN","ISIIMP04",16,0) ; "RTN","ISIIMP05") 0^5^B500995 "RTN","ISIIMP05",1,0) ISIIMP05 ;ISI Group/MLS -- Appointment Create Utility "RTN","ISIIMP05",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP05",3,0) Q "RTN","ISIIMP05",4,0) VALIDATE() "RTN","ISIIMP05",5,0) ; "RTN","ISIIMP05",6,0) S ADATE=$G(ISIMISC("ADATE")) "RTN","ISIIMP05",7,0) S SC=$G(ISIMISC("CLIN")) "RTN","ISIIMP05",8,0) S DFN=$G(ISIMISC("PATIENT")) "RTN","ISIIMP05",9,0) ; "RTN","ISIIMP05",10,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP05",11,0) .W !,"ADATE:",$G(ADATE)," SC:",$G(SC)," DFN:",DFN "RTN","ISIIMP05",12,0) .W !,"" R X "RTN","ISIIMP05",13,0) .Q "RTN","ISIIMP05",14,0) ; "RTN","ISIIMP05",15,0) ; Validate import array contents "RTN","ISIIMP05",16,0) S ISIRC=$$VALAPPT^ISIIMPU2 "RTN","ISIIMP05",17,0) Q ISIRC "RTN","ISIIMP05",18,0) ; "RTN","ISIIMP05",19,0) MAKEAPPT() ; "RTN","ISIIMP05",20,0) ; Create Appointment "RTN","ISIIMP05",21,0) S ISIRC=$$APPT(ADATE,SC,DFN) "RTN","ISIIMP05",22,0) Q ISIRC "RTN","ISIIMP05",23,0) ; "RTN","ISIIMP05",24,0) APPT(ADATE,SC,DFN) "RTN","ISIIMP05",25,0) ; Input - ADATE (Appointment Date [internal fileman format]) "RTN","ISIIMP05",26,0) ; SC (Hospital Location #44) "RTN","ISIIMP05",27,0) ; DFN (Patient DFN #2) "RTN","ISIIMP05",28,0) ; "RTN","ISIIMP05",29,0) ; Output - ISIRC [return code] "RTN","ISIIMP05",30,0) ; "RTN","ISIIMP05",31,0) N COLLAT,SDY,COV,SDYC,OEPTR "RTN","ISIIMP05",32,0) S ^DPT(DFN,"S",ADATE,0)=SC "RTN","ISIIMP05",33,0) S ^SC(SC,"S",ADATE,0)=ADATE "RTN","ISIIMP05",34,0) S:'$D(^DPT(DFN,"S",0)) ^(0)="^2.98P^^" "RTN","ISIIMP05",35,0) S:'$D(^SC(SC,"S",0)) ^(0)="^44.001DA^^" "RTN","ISIIMP05",36,0) F SDY=1:1 I '$D(^SC(SC,"S",ADATE,1,SDY)) S:'$D(^(0)) ^(0)="^44.003PA^^" S ^(SDY,0)=DFN_U_15 Q "RTN","ISIIMP05",37,0) S COLLAT=0,COV=3,SDYC="",COV=$S(COLLAT=1:1,1:3),SDYC=$S(COLLAT=7:1,1:"") "RTN","ISIIMP05",38,0) S:ADATE
OEPTR S ISIRC="-1^Problem getting Oupatient Encounter pointer (#409.69" Q "RTN","ISIIMP05",83,0) S OEPTR=$P($G(^SCE(0)),U,3) "RTN","ISIIMP05",84,0) S ISIRC=1 "RTN","ISIIMP05",85,0) Q "RTN","ISIIMP05",86,0) ; "RTN","ISIIMP05",87,0) DIAG(OEPTR,ICD) "RTN","ISIIMP05",88,0) ;DIAGNOSIS (409.43,.01) POINTER TO ICD DIAGNOSIS FILE (#80) "RTN","ISIIMP05",89,0) ;OUTPATIENT ENCOUNTER (409.43,.02) POINTER OUTPATIENT ENCOUNTER FILE (#409.68) "RTN","ISIIMP05",90,0) ;DIAGNOSIS RANKING (409.43,.03) FREE TEXT "RTN","ISIIMP05",91,0) Q "RTN","ISIIMP05",92,0) ; "RTN","ISIIMP05",93,0) PATAPPT ; "RTN","ISIIMP05",94,0) N FDA,MSG,IENS "RTN","ISIIMP05",95,0) K FDA,MSG "RTN","ISIIMP05",96,0) S IENS=ADATE_","_DFN_"," "RTN","ISIIMP05",97,0) S FDA(2.98,IENS,3)="I" "RTN","ISIIMP05",98,0) S FDA(2.98,IENS,9)=3 "RTN","ISIIMP05",99,0) S FDA(2.98,IENS,19)=DUZ "RTN","ISIIMP05",100,0) S FDA(2.98,IENS,21)=OEPTR "RTN","ISIIMP05",101,0) S FDA(2.98,IENS,22)=1 "RTN","ISIIMP05",102,0) S FDA(2.98,IENS,25)="O" "RTN","ISIIMP05",103,0) S FDA(2.98,IENS,26)=0 "RTN","ISIIMP05",104,0) K ^ZMIKE("PATAPPT") "RTN","ISIIMP05",105,0) M ^ZMIKE("PATAPPT")=FDA "RTN","ISIIMP05",106,0) D FILE^DIE(,"FDA","MSG") "RTN","ISIIMP05",107,0) I $D(MSG) S ISIRC="-1^Problem saving Appointment info (#2.98) - "_$G(MSG("DIERR",1,"TEXT",1)) "RTN","ISIIMP05",108,0) Q:+ISIRC<0 "RTN","ISIIMP05",109,0) S ISIRC=1 "RTN","ISIIMP05",110,0) Q "RTN","ISIIMP06") 0^11^B622120 "RTN","ISIIMP06",1,0) ISIIMP06 ;ISI GROUP/MLS -- Problem Import API "RTN","ISIIMP06",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP06",3,0) Q "RTN","ISIIMP06",4,0) ; "RTN","ISIIMP06",5,0) PROBLEM(ISIRESUL,ISIMISC) "RTN","ISIIMP06",6,0) ;Validate input array "RTN","ISIIMP06",7,0) S ISIRC=$$VALIDATE^ISIIMP07 Q:+ISIRC<0 ISIRC "RTN","ISIIMP06",8,0) ; "RTN","ISIIMP06",9,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP06",10,0) . W !,"+++Post validated/updated array+++ (06)" "RTN","ISIIMP06",11,0) . I $D(ISIMISC) W $G(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,ISIMISC(X) "RTN","ISIIMP06",12,0) . Q "RTN","ISIIMP06",13,0) ; "RTN","ISIIMP06",14,0) ;Create Appointment "RTN","ISIIMP06",15,0) S ISIRC=$$MAKEPROB^ISIIMP07 "RTN","ISIIMP06",16,0) Q ISIRC "RTN","ISIIMP06",17,0) ; "RTN","ISIIMP07") 0^12^B495396 "RTN","ISIIMP07",1,0) ISIIMP07 ;ISI Group/MLS -- Problem Create Utility "RTN","ISIIMP07",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP07",3,0) Q "RTN","ISIIMP07",4,0) VALIDATE() "RTN","ISIIMP07",5,0) ; Validate import array contents "RTN","ISIIMP07",6,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP07",7,0) . W !,"+++Read in values+++ (07)",! "RTN","ISIIMP07",8,0) . I $D(ISIMISC) W $G(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,ISIMISC(X) "RTN","ISIIMP07",9,0) . W !,"" R X "RTN","ISIIMP07",10,0) . Q "RTN","ISIIMP07",11,0) S ISIRC=$$VALPROB^ISIIMPU4(.ISIMISC) "RTN","ISIIMP07",12,0) Q ISIRC "RTN","ISIIMP07",13,0) ; "RTN","ISIIMP07",14,0) MAKEPROB() "RTN","ISIIMP07",15,0) ; Create Problem entry "RTN","ISIIMP07",16,0) S ISIRC=$$CREATE(.ISIMISC) "RTN","ISIIMP07",17,0) Q ISIRC "RTN","ISIIMP07",18,0) ; "RTN","ISIIMP07",19,0) CREATE(ISIMISC) "RTN","ISIIMP07",20,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP07",21,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP07",22,0) ; eg: ISIMISC("PROVIDER")=126 "RTN","ISIIMP07",23,0) ; "RTN","ISIIMP07",24,0) ; Output - ISIRC [return code] "RTN","ISIIMP07",25,0) ; ISIRESUL(0)=1 "RTN","ISIIMP07",26,0) ; ISIRESUL(1)=IEN "RTN","ISIIMP07",27,0) ; "RTN","ISIIMP07",28,0) N GMPDFN,GMPPROV,GMPVAMC,GMPFLD "RTN","ISIIMP07",29,0) K GMPDFN,GMPPROV,GMPVAMC,GMPFLD "RTN","ISIIMP07",30,0) S GMPDFN=ISIMISC("DFN") ; patient dfn "RTN","ISIIMP07",31,0) S GMPPROV=ISIMISC("PROVIDER") ;Provider IEN "RTN","ISIIMP07",32,0) S GMPVAMC=$$KSP^XUPARAM("INST") "RTN","ISIIMP07",33,0) S GMPFLD(".01")=ISIMISC("ICDIEN") ;Code IEN "RTN","ISIIMP07",34,0) S GMPFLD(".03")=0 ;hard set "RTN","ISIIMP07",35,0) S GMPFLD(".05")="^"_ISIMISC("EXPNM") ;Expression text "RTN","ISIIMP07",36,0) S GMPFLD(".08")=DT ; today's date (entry?) "RTN","ISIIMP07",37,0) S GMPFLD(".12")=ISIMISC("STATUS") ;Active/Inactive "RTN","ISIIMP07",38,0) S GMPFLD(".13")=ISIMISC("ONSET") ;Onset date "RTN","ISIIMP07",39,0) S GMPFLD("1.01")=ISIMISC("EXPIEN")_"^"_ISIMISC("EXPNM") ;^LEX(757.01 ien,descip "RTN","ISIIMP07",40,0) S GMPFLD("1.03")=ISIMISC("PROVIDER") ;Entered by "RTN","ISIIMP07",41,0) S GMPFLD("1.04")=ISIMISC("PROVIDER") ;Recording provider "RTN","ISIIMP07",42,0) S GMPFLD("1.05")=ISIMISC("PROVIDER") ;Responsible provider "RTN","ISIIMP07",43,0) S GMPFLD("1.06")=1018 ;MEDICAL SERVICE (#49) "RTN","ISIIMP07",44,0) S GMPFLD("1.07")="" ; Date resolved "RTN","ISIIMP07",45,0) S GMPFLD("1.08")="" ; Clinic (#44) "RTN","ISIIMP07",46,0) S GMPFLD("1.09")=DT ;entry date "RTN","ISIIMP07",47,0) S GMPFLD("1.1")=0 ;Service Connected "RTN","ISIIMP07",48,0) S GMPFLD("1.11")=0 ;Agent Orange exposure "RTN","ISIIMP07",49,0) S GMPFLD("1.12")=0 ;Ionizing radiation exposure "RTN","ISIIMP07",50,0) S GMPFLD("1.13")=0 ;Persian Gulf exposure "RTN","ISIIMP07",51,0) S GMPFLD("1.14")=ISIMISC("TYPE") ;Accute/Chronic (A,C) "RTN","ISIIMP07",52,0) S GMPFLD("1.15")="" ;Head/neck cancer "RTN","ISIIMP07",53,0) S GMPFLD("1.16")="" ;Military sexual trauma "RTN","ISIIMP07",54,0) S GMPFLD("10",0)=0 ;auto set "" "RTN","ISIIMP07",55,0) D NEW^GMPLSAVE "RTN","ISIIMP07",56,0) I '$D(DA) Q "-1^Error creating problem" "RTN","ISIIMP07",57,0) S ISIRESUL(0)=1 "RTN","ISIIMP07",58,0) S ISIRESUL(1)=DA "RTN","ISIIMP07",59,0) Q 1 "RTN","ISIIMP08") 0^20^B366185 "RTN","ISIIMP08",1,0) ISIIMP08 ;ISI GROUP/MLS -- IMPORT VITALS API "RTN","ISIIMP08",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP08",3,0) Q "RTN","ISIIMP08",4,0) VITALS(ISIRESUL,ISIMISC) "RTN","ISIIMP08",5,0) N ERR,VAL "RTN","ISIIMP08",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP08",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP08",8,0) ; "RTN","ISIIMP08",9,0) ;Validate setup & parameters "RTN","ISIIMP08",10,0) S ISIRC=$$VALIDATE^ISIIMP09 Q:+ISIRC<0 ISIRC "RTN","ISIIMP08",11,0) ;Create patient record "RTN","ISIIMP08",12,0) S ISIRC=$$MAKEVIT^ISIIMP09 Q:+ISIRC<0 ISIRC "RTN","ISIIMP08",13,0) ; Quit with DFN "RTN","ISIIMP08",14,0) Q ISIRC "RTN","ISIIMP09") 0^17^B368521 "RTN","ISIIMP09",1,0) ISIIMP09 ;;ISI GROUP/MLS -- VITALS IMPORT CONT. "RTN","ISIIMP09",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP09",3,0) Q "RTN","ISIIMP09",4,0) ; "RTN","ISIIMP09",5,0) VALIDATE() ; "RTN","ISIIMP09",6,0) ; Validate import array contents "RTN","ISIIMP09",7,0) S ISIRC=$$VALVITAL^ISIIMPU5(.ISIMISC) "RTN","ISIIMP09",8,0) Q ISIRC "RTN","ISIIMP09",9,0) ; "RTN","ISIIMP09",10,0) MAKEVIT() ; "RTN","ISIIMP09",11,0) ; Create patient(s) "RTN","ISIIMP09",12,0) S ISIRC=$$IMPORTVT(.ISIMISC) "RTN","ISIIMP09",13,0) Q ISIRC "RTN","ISIIMP09",14,0) ; "RTN","ISIIMP09",15,0) IMPORTVT(ISIMISC) ;Create Vitals entry "RTN","ISIIMP09",16,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP09",17,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP09",18,0) ; eg: ISIMISC("DFN")=12345 "RTN","ISIIMP09",19,0) ; "RTN","ISIIMP09",20,0) ; Output - ISIRC [return code] "RTN","ISIIMP09",21,0) N DT,DFN,TYP,RT,LOC,ENT "RTN","ISIIMP09",22,0) D PREP "RTN","ISIIMP09",23,0) D VITALS "RTN","ISIIMP09",24,0) Q ISIRC "RTN","ISIIMP09",25,0) ; "RTN","ISIIMP09",26,0) PREP "RTN","ISIIMP09",27,0) S DT=$G(ISIMISC("DT_TAKEN")) "RTN","ISIIMP09",28,0) S DFN=$G(ISIMISC("DFN")) "RTN","ISIIMP09",29,0) S TYP=$G(ISIMISC("VITAL_TYPE")) "RTN","ISIIMP09",30,0) I $G(ISIMISC("RATE"))="" S ISIMISC("RATE")=$$GEN(TYP) "RTN","ISIIMP09",31,0) S RT=$G(ISIMISC("RATE")) "RTN","ISIIMP09",32,0) S LOC=$G(ISIMISC("LOCATION")) "RTN","ISIIMP09",33,0) S ENT=$G(ISIMISC("ENTERED_BY")) "RTN","ISIIMP09",34,0) Q "RTN","ISIIMP09",35,0) ; "RTN","ISIIMP09",36,0) VITALS ;Add vitals for patient "RTN","ISIIMP09",37,0) N RESULT K RESULT "RTN","ISIIMP09",38,0) S DATA=DT_U_DFN_U_TYP_";"_RT_U_LOC_U_ENT "RTN","ISIIMP09",39,0) D EN1^GMVDCSAV(.RESULT,DATA) "RTN","ISIIMP09",40,0) I $G(RESULT(0))["ERROR" S ISIRC="-1^Error creating Vital entry (ISIIMP09)" "RTN","ISIIMP09",41,0) Q:+ISIRC<0 "RTN","ISIIMP09",42,0) S ISIRESUL(0)="1" "RTN","ISIIMP09",43,0) S ISIRESUL(1)="success" "RTN","ISIIMP09",44,0) Q "RTN","ISIIMP09",45,0) ; "RTN","ISIIMP09",46,0) GEN(TYPE) ;Generate values for vitals "RTN","ISIIMP09",47,0) N READ "RTN","ISIIMP09",48,0) S:TYPE=1 READ=($R(80)+110)_"/"_($R(30)+55) "RTN","ISIIMP09",49,0) S:TYPE=2 READ=($R(2)+97)_"."_($R(9)+1) "RTN","ISIIMP09",50,0) S:TYPE=3 READ=$R(8)+12 "RTN","ISIIMP09",51,0) S:TYPE=5 READ=$R(30)+65 "RTN","ISIIMP09",52,0) I TYPE=8 D "RTN","ISIIMP09",53,0) .S HGT=$S($P($G(^GMR(120.5,+$O(^PXRMINDX(120.5,"PI",DFN,8,+$O(^PXRMINDX(120.5,"PI",DFN,8,""),-1),0)),0)),U,8):$P(^(0),U,8),1:(60+$R(18))) "RTN","ISIIMP09",54,0) .S READ=HGT "RTN","ISIIMP09",55,0) I TYPE=9 D "RTN","ISIIMP09",56,0) . S WGT=$S($P($G(^GMR(120.5,+$O(^PXRMINDX(120.5,"PI",DFN,9,+$O(^PXRMINDX(120.5,"PI",DFN,9,""),-1),0)),0)),U,8):$P(^(0),U,8),1:(110+$R(150))) "RTN","ISIIMP09",57,0) . S GORL=$R(2),LBS=$R(5),(READ,WGT)=WGT+($S(GORL=0:"-",1:"+")_LBS) "RTN","ISIIMP09",58,0) S:TYPE=21 READ=$R(9)+91 "RTN","ISIIMP09",59,0) S:TYPE=22 READ=$R(3) "RTN","ISIIMP09",60,0) Q READ "RTN","ISIIMP09",61,0) "RTN","ISIIMP10") 0^18^B366470 "RTN","ISIIMP10",1,0) ISIIMP10 ;ISI GROUP/MLS -- ALLERGY IMPORT API "RTN","ISIIMP10",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP10",3,0) Q "RTN","ISIIMP10",4,0) ALLERGY(ISIRESUL,ISIMISC) "RTN","ISIIMP10",5,0) N ERR,VAL "RTN","ISIIMP10",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP10",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP10",8,0) ; "RTN","ISIIMP10",9,0) ;Validate setup & parameters "RTN","ISIIMP10",10,0) S ISIRC=$$VALIDATE^ISIIMP11 Q:+ISIRC<0 ISIRC "RTN","ISIIMP10",11,0) ;Create patient record "RTN","ISIIMP10",12,0) S ISIRC=$$MAKEALG^ISIIMP11 Q:+ISIRC<0 ISIRC "RTN","ISIIMP10",13,0) Q ISIRC "RTN","ISIIMP11") 0^19^B396503 "RTN","ISIIMP11",1,0) ISIIMP11 ;;ISI GROUP/MLS -- ALLERGIES IMPORT CONT. "RTN","ISIIMP11",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP11",3,0) Q "RTN","ISIIMP11",4,0) ; "RTN","ISIIMP11",5,0) VALIDATE() ; "RTN","ISIIMP11",6,0) ; Validate import array contents "RTN","ISIIMP11",7,0) S ISIRC=$$VALALG^ISIIMPU6(.ISIMISC) "RTN","ISIIMP11",8,0) Q ISIRC "RTN","ISIIMP11",9,0) ; "RTN","ISIIMP11",10,0) MAKEALG() ; "RTN","ISIIMP11",11,0) ; Create patient(s) "RTN","ISIIMP11",12,0) S ISIRC=$$IMPRTALG(.ISIMISC) "RTN","ISIIMP11",13,0) Q ISIRC "RTN","ISIIMP11",14,0) ; "RTN","ISIIMP11",15,0) IMPRTALG(ISIMISC) ;Create allergy entry "RTN","ISIIMP11",16,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP11",17,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP11",18,0) ; eg: ISIMISC("GMRAORIG")=12345 "RTN","ISIIMP11",19,0) ; "RTN","ISIIMP11",20,0) ; Output - ISIRC [return code] "RTN","ISIIMP11",21,0) ; ISIRESUL(0)=1 [if successful] "RTN","ISIIMP11",22,0) ; ISIRESUL(1)="success" [if successful] "RTN","ISIIMP11",23,0) ; "RTN","ISIIMP11",24,0) N NODE,DFN,GMRARRAY,GMRAIEN "RTN","ISIIMP11",25,0) D PREP "RTN","ISIIMP11",26,0) D ALLERGY "RTN","ISIIMP11",27,0) Q ISIRC "RTN","ISIIMP11",28,0) ; "RTN","ISIIMP11",29,0) PREP "RTN","ISIIMP11",30,0) S GMRAIEN=0 ; used for update "RTN","ISIIMP11",31,0) S DFN=ISIMISC("DFN") "RTN","ISIIMP11",32,0) K ISIMISC("ALLERGEN"),ISIMISC("DFN"),ISIMISC("HISTORIC"),ISIMISC("ORIGINTR"),ISIMISC("ORIG_DATE") "RTN","ISIIMP11",33,0) K ISIMISC("PAT_SSN"),ISIMISC("SYMPTOM") "RTN","ISIIMP11",34,0) S NODE=$NAME(^TMP("GMRA",$J)) "RTN","ISIIMP11",35,0) K @NODE M @NODE=ISIMISC "RTN","ISIIMP11",36,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP11",37,0) . W !,"+++ Final values +++" "RTN","ISIIMP11",38,0) . W !,"DFN:",DFN,! "RTN","ISIIMP11",39,0) . I $D(ISIMISC) W $G(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,X,":",ISIMISC(X) "RTN","ISIIMP11",40,0) . Q "RTN","ISIIMP11",41,0) Q "RTN","ISIIMP11",42,0) ; "RTN","ISIIMP11",43,0) ALLERGY ;Add Allergies for patient "RTN","ISIIMP11",44,0) D UPDATE^GMRAGUI1(0,DFN,NODE) "RTN","ISIIMP11",45,0) Q:+ISIRC<0 ;error "RTN","ISIIMP11",46,0) S ISIRESUL(0)=1 "RTN","ISIIMP11",47,0) S ISIRESUL(1)="Success" "RTN","ISIIMP11",48,0) Q "RTN","ISIIMP12") 0^21^B357413 "RTN","ISIIMP12",1,0) ISIIMP12 ;ISI GROUP/MLS -- LABS IMPORT API "RTN","ISIIMP12",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP12",3,0) Q "RTN","ISIIMP12",4,0) LAB(ISIRESUL,ISIMISC) "RTN","ISIIMP12",5,0) N ERR,VAL "RTN","ISIIMP12",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP12",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP12",8,0) ; "RTN","ISIIMP12",9,0) ;Validate setup & parameters "RTN","ISIIMP12",10,0) S ISIRC=$$VALIDATE^ISIIMP13 Q:+ISIRC<0 ISIRC "RTN","ISIIMP12",11,0) ;Create patient record "RTN","ISIIMP12",12,0) S ISIRC=$$MAKELAB^ISIIMP13 Q:+ISIRC<0 ISIRC "RTN","ISIIMP12",13,0) Q ISIRC "RTN","ISIIMP13") 0^22^B1361576 "RTN","ISIIMP13",1,0) ISIIMP13 ;ISI GROUP/MLS -- LABS IMPORT CONT. "RTN","ISIIMP13",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP13",3,0) Q "RTN","ISIIMP13",4,0) ; "RTN","ISIIMP13",5,0) VALIDATE() ; "RTN","ISIIMP13",6,0) ; Validate import array contents "RTN","ISIIMP13",7,0) S ISIRC=$$VALLAB^ISIIMPU7(.ISIMISC) "RTN","ISIIMP13",8,0) Q ISIRC "RTN","ISIIMP13",9,0) ; "RTN","ISIIMP13",10,0) MAKELAB() ; "RTN","ISIIMP13",11,0) ; Create patient(s) "RTN","ISIIMP13",12,0) S ISIRC=$$IMPRTLAB(.ISIMISC) "RTN","ISIIMP13",13,0) Q ISIRC "RTN","ISIIMP13",14,0) ; "RTN","ISIIMP13",15,0) IMPRTLAB(ISIMISC) ;Create lab entry "RTN","ISIIMP13",16,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP13",17,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP13",18,0) ; eg: ISIMISC("RESULT_VAL")=110 "RTN","ISIIMP13",19,0) ; "RTN","ISIIMP13",20,0) ; Output - ISIRC [return code] "RTN","ISIIMP13",21,0) ; ISIRESUL(0)=1 [if successful] "RTN","ISIIMP13",22,0) ; ISIRESUL(1)="success" [if successful] "RTN","ISIIMP13",23,0) ; "RTN","ISIIMP13",24,0) N NODE,DFN "RTN","ISIIMP13",25,0) ; "RTN","ISIIMP13",26,0) I ^%ZOSF("OS")["GT.M" N ZIO K ZIO M ZIO=IO N IO M IO=ZIO S %ZIS="OH",IOP="NULL" D ^%ZIS S XWBNULL=IO,IO(0)=IO O IO(0) U IO(0) "RTN","ISIIMP13",27,0) ; "RTN","ISIIMP13",28,0) D PREP Q:+ISIRC<0 ISIRC "RTN","ISIIMP13",29,0) D LAB "RTN","ISIIMP13",30,0) ; "RTN","ISIIMP13",31,0) I ^%ZOSF("OS")["GT.M" U XWBTDEV:(nowrap:nodelimiter:ioerror="TRAP") "RTN","ISIIMP13",32,0) ; "RTN","ISIIMP13",33,0) Q ISIRC "RTN","ISIIMP13",34,0) ; "RTN","ISIIMP13",35,0) PREP "RTN","ISIIMP13",36,0) ; "RTN","ISIIMP13",37,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP13",38,0) . W !,"+++ Pre-Prep values +++",! "RTN","ISIIMP13",39,0) . I $D(ISIMISC) W $G(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,ISIMISC(X) "RTN","ISIIMP13",40,0) . W !,"" R X "RTN","ISIIMP13",41,0) . Q "RTN","ISIIMP13",42,0) D KILL "RTN","ISIIMP13",43,0) S LRWP=1,LRQUIET=1 "RTN","ISIIMP13",44,0) S DFN=ISIMISC("DFN") "RTN","ISIIMP13",45,0) S LRZPT=DFN "RTN","ISIIMP13",46,0) S NODE=$NAME(^TMP("LRSTIK",$J)) "RTN","ISIIMP13",47,0) S LRLLOC=ISIMISC("LOCATION") "RTN","ISIIMP13",48,0) S ^TMP("LRVEHU",$J,"R")=ISIMISC("RESULT_VAL") "RTN","ISIIMP13",49,0) S ^TMP("LRVEHU",$J,"I")=ISIMISC("INITIALS") "RTN","ISIIMP13",50,0) S ^TMP("LRVEHU",$J,"COLL")=ISIMISC("RESULT_DT") "RTN","ISIIMP13",51,0) S ^TMP("LRVEHU",$J,"PT",DFN)="" "RTN","ISIIMP13",52,0) K ISIMISC("ENTERED_BY"),ISIMISC("LAB_TEST"),ISIMISC("DFN"),ISIMISC("RESULT_VAL") "RTN","ISIIMP13",53,0) K ISIMISC("INITIALS"),ISIMISC("LOCATION") "RTN","ISIIMP13",54,0) K @NODE M @NODE=ISIMISC "RTN","ISIIMP13",55,0) D EN^LRPARAM I $G(LREND) D KILL S ISIRC="-1^Invalid set up detected (ISIIMP13)" Q "RTN","ISIIMP13",56,0) Q "RTN","ISIIMP13",57,0) ; "RTN","ISIIMP13",58,0) LAB ;Add LAB for patient "RTN","ISIIMP13",59,0) D EN Q:+ISIRC<0 "RTN","ISIIMP13",60,0) D STAT Q:+ISIRC<0 "RTN","ISIIMP13",61,0) S ISIRESUL(0)=1 "RTN","ISIIMP13",62,0) S ISIRESUL(1)="Success" "RTN","ISIIMP13",63,0) S ISIRC=1 "RTN","ISIIMP13",64,0) Q "RTN","ISIIMP13",65,0) ; "RTN","ISIIMP13",66,0) EN ;from LROR4 "RTN","ISIIMP13",67,0) K DIC,LRURG,LRSAME,LRCOM,LRNATURE,LRTCOM "RTN","ISIIMP13",68,0) S LRORDR="WC" "RTN","ISIIMP13",69,0) S LRORDTIM="" "RTN","ISIIMP13",70,0) I $D(LRADDTST) Q:LRADDTST="" "RTN","ISIIMP13",71,0) S LRFIRST=1,LRODT=DT,U="^",LRECT=0,LROUTINE=$P(^LAB(69.9,1,3),U,2) "RTN","ISIIMP13",72,0) S:$G(LRORDRR)="R" LRECT=1,LRFIRST=0 "RTN","ISIIMP13",73,0) I LRORDR="SP" S LRLWC="SP" "RTN","ISIIMP13",74,0) I LRORDR="WC" S LRLWC="WC" "RTN","ISIIMP13",75,0) L5 S Y=$$NOW^XLFDT S LRORDTIM=$P(Y,".",2),LRODT=$P(Y,".",1),X1=Y,X2=DT D ^%DTC ;; JFR def order time "RTN","ISIIMP13",76,0) G KILL:$G(LRWP)<1!($G(LRWP)="") "RTN","ISIIMP13",77,0) ;S LRWP=1 "RTN","ISIIMP13",78,0) S:'$D(^LRO(69,LRODT,0)) ^(0)=$P(^LRO(69,0),U,1,2)_U_LRODT_U_(1+$P(^(0),U,4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)="" "RTN","ISIIMP13",79,0) S LRURG="",LRAD=DT,LRWPD=LRWP\2+(LRWP#2) "RTN","ISIIMP13",80,0) S LRQUIET=1 "RTN","ISIIMP13",81,0) D LRZORD1^ISIIMPL2 "RTN","ISIIMP13",82,0) Q "RTN","ISIIMP13",83,0) ; "RTN","ISIIMP13",84,0) KILL D ^LRORDK,LROEND^LRORDK K ^TMP("LRVEHU",$J),^TMP("LRSTIK",$J) "RTN","ISIIMP13",85,0) Q "RTN","ISIIMP13",86,0) ; "RTN","ISIIMP13",87,0) STAT ; "RTN","ISIIMP13",88,0) D EN^LRPARAM "RTN","ISIIMP13",89,0) I '$D(LRLABKY) S ISIRC="-1^You do not have the proper security keys" Q "RTN","ISIIMP13",90,0) ; "RTN","ISIIMP13",91,0) S X=DUZ(2) "RTN","ISIIMP13",92,0) I X<1 D END Q "RTN","ISIIMP13",93,0) I X'=DUZ(2) N LRPL S LRPL=X "RTN","ISIIMP13",94,0) ; "RTN","ISIIMP13",95,0) S LRLONG="",LRPANEL=0,LROESTAT="" "RTN","ISIIMP13",96,0) S %H=$H-60 D YMD^LRX S LRTM60=9999999-X "RTN","ISIIMP13",97,0) S LRQUIET=1 "RTN","ISIIMP13",98,0) D LRZOE^ISIIMPL1 K LRTM60,LRLONG,LREND,LROESTAT "RTN","ISIIMP13",99,0) ; "RTN","ISIIMP13",100,0) D END "RTN","ISIIMP13",101,0) Q "RTN","ISIIMP13",102,0) ; "RTN","ISIIMP13",103,0) END K DIR,DIRUT,GOT "RTN","ISIIMP13",104,0) D ^LRORDK,LROEND^LRORDK,STOP^LRCAPV "RTN","ISIIMP13",105,0) Q "RTN","ISIIMP14") 0^29^B367014 "RTN","ISIIMP14",1,0) ISIIMP14 ;ISI GROUP/MLS -- NOTES IMPORT API "RTN","ISIIMP14",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP14",3,0) Q "RTN","ISIIMP14",4,0) NOTES(ISIRESUL,ISIMISC) "RTN","ISIIMP14",5,0) N ERR,VAL "RTN","ISIIMP14",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP14",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP14",8,0) ; "RTN","ISIIMP14",9,0) ;Validate setup & parameters "RTN","ISIIMP14",10,0) S ISIRC=$$VALIDATE^ISIIMP15 Q:+ISIRC<0 ISIRC "RTN","ISIIMP14",11,0) ;Create patient record "RTN","ISIIMP14",12,0) S ISIRC=$$MAKENOTE^ISIIMP15 Q:+ISIRC<0 ISIRC "RTN","ISIIMP14",13,0) Q ISIRC "RTN","ISIIMP15") 0^30^B977286 "RTN","ISIIMP15",1,0) ISIIMP15 ;ISI GROUP/MLS -- NOTES IMPORT CONT. "RTN","ISIIMP15",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP15",3,0) Q "RTN","ISIIMP15",4,0) ; "RTN","ISIIMP15",5,0) VALIDATE() ; "RTN","ISIIMP15",6,0) ; Validate import array contents "RTN","ISIIMP15",7,0) S ISIRC=$$VALNOTE^ISIIMPU8(.ISIMISC) "RTN","ISIIMP15",8,0) Q ISIRC "RTN","ISIIMP15",9,0) ; "RTN","ISIIMP15",10,0) MAKENOTE() ; "RTN","ISIIMP15",11,0) ; Create patient(s) "RTN","ISIIMP15",12,0) S ISIRC=$$IMPRTNOT(.ISIMISC) "RTN","ISIIMP15",13,0) Q ISIRC "RTN","ISIIMP15",14,0) ; "RTN","ISIIMP15",15,0) IMPRTNOT(ISIMISC) ;Create Progress Note entry "RTN","ISIIMP15",16,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP15",17,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP15",18,0) ; eg: ISIMISC("DFN")=12345 "RTN","ISIIMP15",19,0) ; "RTN","ISIIMP15",20,0) ; Output - ISIRC [return code] "RTN","ISIIMP15",21,0) ; ISIRESUL(0)=1 [if successful] "RTN","ISIIMP15",22,0) ; ISIRESUL(1)=TIUDA [if successful] "RTN","ISIIMP15",23,0) ; "RTN","ISIIMP15",24,0) N DFN,VDT,ARRAY,SUPPRESS,NOASF,RESULT,VLOC,TIUDA,TITLE,TEXT,SIGN,VSTR,PROV "RTN","ISIIMP15",25,0) S ISIRC=1,RESULT="" "RTN","ISIIMP15",26,0) D PREP "RTN","ISIIMP15",27,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP15",28,0) D MAKETIU "RTN","ISIIMP15",29,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP15",30,0) D INSTXT "RTN","ISIIMP15",31,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP15",32,0) D SIGN "RTN","ISIIMP15",33,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP15",34,0) S ISIRESUL(0)=1,ISIRESUL(1)=$G(TIUDA) "RTN","ISIIMP15",35,0) Q 1 "RTN","ISIIMP15",36,0) ; "RTN","ISIIMP15",37,0) PREP "RTN","ISIIMP15",38,0) S DFN=$G(ISIMISC("DFN")) "RTN","ISIIMP15",39,0) S TITLE=$G(ISIMISC("TIU")) "RTN","ISIIMP15",40,0) S VLOC=$G(ISIMISC("VLOC")) "RTN","ISIIMP15",41,0) S PROV=$G(ISIMISC("PROV")) "RTN","ISIIMP15",42,0) S VDT=$G(ISIMISC("VDT")) "RTN","ISIIMP15",43,0) S TEXT=$G(ISIMISC("TEXT")) "RTN","ISIIMP15",44,0) K ARRAY "RTN","ISIIMP15",45,0) S ARRAY(1202)=PROV "RTN","ISIIMP15",46,0) S ARRAY(1301)=VDT "RTN","ISIIMP15",47,0) S ARRAY(1205)=VLOC "RTN","ISIIMP15",48,0) S VSTR=ISIMISC("VISIT") "RTN","ISIIMP15",49,0) S SUPPRESS=0 "RTN","ISIIMP15",50,0) S NOASF="" "RTN","ISIIMP15",51,0) S SIGN=$G(ISIMISC("ES")) "RTN","ISIIMP15",52,0) S ISIRC=$S(DFN="":-1,TITLE="":-1,VLOC="":-1,PROV="":-1,VDT="":-1,VSTR="":-1,SIGN="":-1,1:1) "RTN","ISIIMP15",53,0) I ISIRC=-1 S ISIRC="-1^Validation error (PREP ISIIMP15)" Q "RTN","ISIIMP15",54,0) Q "RTN","ISIIMP15",55,0) ; "RTN","ISIIMP15",56,0) MAKETIU "RTN","ISIIMP15",57,0) D MAKE^TIUSRVP(.RESULT,DFN,TITLE,VDT,VLOC,"",.ARRAY,VSTR,SUPPRESS,NOASF) "RTN","ISIIMP15",58,0) I +RESULT<1 S ISIRC="-1^Unable to create note" Q "RTN","ISIIMP15",59,0) S TIUDA=RESULT "RTN","ISIIMP15",60,0) Q "RTN","ISIIMP15",61,0) ; "RTN","ISIIMP15",62,0) INSTXT "RTN","ISIIMP15",63,0) K ARRAY "RTN","ISIIMP15",64,0) S ARRAY("TEXT",1,0)=TEXT "RTN","ISIIMP15",65,0) S ARRAY("HDR")="1^1" "RTN","ISIIMP15",66,0) D SETTEXT^TIUSRVPT(.RESULT,TIUDA,.ARRAY,0) "RTN","ISIIMP15",67,0) I +RESULT<1 S ISIRC="-1^Unable to insert text into note" Q "RTN","ISIIMP15",68,0) Q "RTN","ISIIMP15",69,0) ; "RTN","ISIIMP15",70,0) SIGN "RTN","ISIIMP15",71,0) N ES "RTN","ISIIMP15",72,0) S ES=$$ENCRYP^XUSRB1(SIGN) "RTN","ISIIMP15",73,0) D SIGN^TIUSRVP2(.RESULT,TIUDA,ES) "RTN","ISIIMP15",74,0) I +RESULT<0 S ISIRC="-1^Unable to electronically sign note" Q "RTN","ISIIMP15",75,0) Q "RTN","ISIIMP16") 0^31^B364510 "RTN","ISIIMP16",1,0) ISIIMP16 ;ISI GROUP/MLS -- MEDS Import API "RTN","ISIIMP16",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP16",3,0) Q "RTN","ISIIMP16",4,0) MEDS(ISIRESUL,ISIMISC) "RTN","ISIIMP16",5,0) N ERR,VAL "RTN","ISIIMP16",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP16",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP16",8,0) ; "RTN","ISIIMP16",9,0) ;Validate setup & parameters "RTN","ISIIMP16",10,0) S ISIRC=$$VALIDATE^ISIIMP17 Q:+ISIRC<0 ISIRC "RTN","ISIIMP16",11,0) ;Create patient record "RTN","ISIIMP16",12,0) S ISIRC=$$MAKEMEDS^ISIIMP17 Q:+ISIRC<0 ISIRC "RTN","ISIIMP16",13,0) Q ISIRC "RTN","ISIIMP17") 0^32^B1304142 "RTN","ISIIMP17",1,0) ISIIMP17 ;ISI GROUP/MLS -- MEDS IMPORT CONT. "RTN","ISIIMP17",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP17",3,0) Q "RTN","ISIIMP17",4,0) ; "RTN","ISIIMP17",5,0) VALIDATE() ; "RTN","ISIIMP17",6,0) ; Validate import array contents "RTN","ISIIMP17",7,0) S ISIRC=$$VALMEDS^ISIIMPU9(.ISIMISC) "RTN","ISIIMP17",8,0) Q ISIRC "RTN","ISIIMP17",9,0) ; "RTN","ISIIMP17",10,0) MAKEMEDS() ; "RTN","ISIIMP17",11,0) ; Create patient(s) "RTN","ISIIMP17",12,0) S ISIRC=$$MEDS(.ISIMISC) "RTN","ISIIMP17",13,0) Q ISIRC "RTN","ISIIMP17",14,0) ; "RTN","ISIIMP17",15,0) MEDS(ISIMISC) ;Create med order entry "RTN","ISIIMP17",16,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP17",17,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP17",18,0) ; eg: ISIMISC("DFN")=123455 "RTN","ISIIMP17",19,0) ; "RTN","ISIIMP17",20,0) ; Output - ISIRC [return code] "RTN","ISIIMP17",21,0) ; ISIRESUL(0)=1 [if successful] "RTN","ISIIMP17",22,0) ; ISIRESUL(1)=PSOIEN [if successful] "RTN","ISIIMP17",23,0) ; "RTN","ISIIMP17",24,0) N ORZPT,PNTSTAT,PROV,PSODRUG,QTY,DAYSUPLY,REFIL,ORDCONV,RXNUM,PSOIEN "RTN","ISIIMP17",25,0) N COPIES,MLWIND,ENTERBY,UNITPRICE,PSOSITE,LOGDT,DISPDT,ISSDT,SIG "RTN","ISIIMP17",26,0) N X1,X2,EXPIRDT,STATUS,TRNSTYP,LDISPDT,FILLDT,PORDITM,REASON "RTN","ISIIMP17",27,0) N INIT,COM "RTN","ISIIMP17",28,0) ; "RTN","ISIIMP17",29,0) S ISIRC=1 "RTN","ISIIMP17",30,0) D PREP "RTN","ISIIMP17",31,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP17",32,0) D CREATE "RTN","ISIIMP17",33,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP17",34,0) S ISIRESUL(0)=1 "RTN","ISIIMP17",35,0) S ISIRESUL(1)=PSOIEN "RTN","ISIIMP17",36,0) Q ISIRC "RTN","ISIIMP17",37,0) ; "RTN","ISIIMP17",38,0) PREP "RTN","ISIIMP17",39,0) ; "RTN","ISIIMP17",40,0) N EXIT "RTN","ISIIMP17",41,0) S ORZPT=ISIMISC("DFN") ;"" ;POINTER TO PATIENT FILE (#2) "RTN","ISIIMP17",42,0) S PSODFN=ORZPT "RTN","ISIIMP17",43,0) S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53) "RTN","ISIIMP17",44,0) S PROV=ISIMISC("PROV") ;NEW PERSON FILE (#200) "RTN","ISIIMP17",45,0) S PSODRUG=ISIMISC("DRUG") ;"" ;POINTER TO DRUG FILE (#50) "RTN","ISIIMP17",46,0) S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3) "RTN","ISIIMP17",47,0) S QTY=ISIMISC("QTY") ;NUMBER ;0;7 NUMBER (Required) "RTN","ISIIMP17",48,0) S DAYSUPLY=ISIMISC("SUPPLY") ;NUMBER ; 0;8 NUMBER (Required) "RTN","ISIIMP17",49,0) S REFIL=ISIMISC("REFILL") ;NUMBER ; 0;9 NUMBER (Required) "RTN","ISIIMP17",50,0) S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS; "RTN","ISIIMP17",51,0) S COPIES=1 ;NUMBER "RTN","ISIIMP17",52,0) S MLWIND="W" ;'M' or 'W' "RTN","ISIIMP17",53,0) S ENTERBY=DUZ ;NEW PERSON FILE (#200) "RTN","ISIIMP17",54,0) S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER "RTN","ISIIMP17",55,0) S PSOSITE=ISIMISC("PSOSITE") ; OUTPATIENT SITE FILE (#59) "RTN","ISIIMP17",56,0) D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required) "RTN","ISIIMP17",57,0) S FILLDT=ISIMISC("DATE") ;DATE "RTN","ISIIMP17",58,0) S ISSDT=FILLDT ;DATE "RTN","ISIIMP17",59,0) S DISPDT=ISSDT ;DATE "RTN","ISIIMP17",60,0) S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180 "RTN","ISIIMP17",61,0) S EXPIRDT=X ; "RTN","ISIIMP17",62,0) S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7) "RTN","ISIIMP17",63,0) S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE; "RTN","ISIIMP17",64,0) S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1) "RTN","ISIIMP17",65,0) S LDISPDT=FILLDT ; 3;1 DATE "RTN","ISIIMP17",66,0) S REASON="E" ;Activity log ; SET ([E]dit) "RTN","ISIIMP17",67,0) S INIT=DUZ ;NEW PERSON FILE (#200) "RTN","ISIIMP17",68,0) S COM="Oupatient medication order." ;TEXT "RTN","ISIIMP17",69,0) S SIG=ISIMISC("SIG") ;#51,.01 "RTN","ISIIMP17",70,0) Q "RTN","ISIIMP17",71,0) ; "RTN","ISIIMP17",72,0) CREATE "RTN","ISIIMP17",73,0) D AUTO^PSONRXN ;RX auto number "RTN","ISIIMP17",74,0) I $G(PSONEW("RX #"))="" S ISIRC="-1^RX Auto number error." Q "RTN","ISIIMP17",75,0) S RXNUM=PSONEW("RX #") "RTN","ISIIMP17",76,0) ; "RTN","ISIIMP17",77,0) S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 "RTN","ISIIMP17",78,0) I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q ;pointer error "RTN","ISIIMP17",79,0) S $P(^PSRX(0),U,3)=PSOIEN "RTN","ISIIMP17",80,0) ; "RTN","ISIIMP17",81,0) S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required) "RTN","ISIIMP17",82,0) S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required) "RTN","ISIIMP17",83,0) S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2) "RTN","ISIIMP17",84,0) S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53) "RTN","ISIIMP17",85,0) S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200) "RTN","ISIIMP17",86,0) S $P(^PSRX(PSOIEN,0),"^",5)="" ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44) "RTN","ISIIMP17",87,0) S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50) "RTN","ISIIMP17",88,0) S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required) "RTN","ISIIMP17",89,0) S $P(^PSRX(PSOIEN,0),"^",8)=DAYSUPLY ;NUMBER ; 0;8 NUMBER (Required) "RTN","ISIIMP17",90,0) S $P(^PSRX(PSOIEN,0),"^",9)=REFIL ;NUMBER ; 0;9 NUMBER (Required) "RTN","ISIIMP17",91,0) S $P(^PSRX(PSOIEN,0),"^",11)=MLWIND ;'M' or 'W' "RTN","ISIIMP17",92,0) S $P(^PSRX(PSOIEN,0),"^",16)=ENTERBY ;NEW PERSON FILE (#200) "RTN","ISIIMP17",93,0) S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER "RTN","ISIIMP17",94,0) S $P(^PSRX(PSOIEN,0),"^",18)=COPIES ;COPIES "RTN","ISIIMP17",95,0) S $P(^PSRX(PSOIEN,0),"^",19)=ORDCONV ;ORDER CONVERTED 0;19 SET ['1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;] "RTN","ISIIMP17",96,0) ; "RTN","ISIIMP17",97,0) S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required) "RTN","ISIIMP17",98,0) S $P(^PSRX(PSOIEN,2),"^",2)=FILLDT ;FILL DATE "RTN","ISIIMP17",99,0) ;S $P(^PSRX(PSOIEN,2),"^",3)=PHARMACIST ; "" ; PHARMACIST ;2;3 POINTER TO NEW PERSON FILE (#200) "RTN","ISIIMP17",100,0) ;S $P(^PSRX(PSOIEN,2),"^",4)="" ; LOT # 2;4 FREE TEXT "RTN","ISIIMP17",101,0) S $P(^PSRX(PSOIEN,2),"^",5)=DISPDT ; DISPENSED DATE 2;5 DATE (Required) "RTN","ISIIMP17",102,0) S $P(^PSRX(PSOIEN,2),"^",6)=EXPIRDT ;"" ; EXPIRATION DATE "RTN","ISIIMP17",103,0) S $P(^PSRX(PSOIEN,2),"^",9)=PSOSITE ;2;9 POINTER TO OUTPATIENT SITE FILE (#59) "RTN","ISIIMP17",104,0) ; "RTN","ISIIMP17",105,0) S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE 3;1 DATE "RTN","ISIIMP17",106,0) ; "RTN","ISIIMP17",107,0) S ^PSRX(PSOIEN,"A",0)="^52.3DA^1^1" "RTN","ISIIMP17",108,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",1)=LOGDT ;DATE "RTN","ISIIMP17",109,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",2)=REASON ;SET "RTN","ISIIMP17",110,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",3)=INIT ;NEW PERSON FILE (#200) "RTN","ISIIMP17",111,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",4)=0 ;NUMBER - RX REFERENCE "RTN","ISIIMP17",112,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",5)="ISI automated entry." ;TEXT "RTN","ISIIMP17",113,0) ; "RTN","ISIIMP17",114,0) S ^PSRX(PSOIEN,"OR1")=PORDITM ;PHARMACY ORDERABLE ITEM FILE (#50.7) "RTN","ISIIMP17",115,0) ; "RTN","ISIIMP17",116,0) S $P(^PSRX(PSOIEN,"POE"),"^",1)=1 ; POE RX POE;1 SET ['1' FOR YES;] "RTN","ISIIMP17",117,0) ; "RTN","ISIIMP17",118,0) S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required) medication instruction DIC(51) "RTN","ISIIMP17",119,0) S $P(^PSRX(PSOIEN,"SIG"),"^",2)=0 ;OERR SIG (SET: 0 for NO; 1 for YES) "RTN","ISIIMP17",120,0) ; "RTN","ISIIMP17",121,0) S $P(^PSRX(PSOIEN,"STA"),"^",1)=STATUS ;STA;1 SET (Required) ; '0' FOR ACTIVE; "RTN","ISIIMP17",122,0) ; "RTN","ISIIMP17",123,0) ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1) "RTN","ISIIMP17",124,0) S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER "RTN","ISIIMP17",125,0) D OERR,F55,F52,F525 "RTN","ISIIMP17",126,0) Q "RTN","ISIIMP17",127,0) ; "RTN","ISIIMP17",128,0) OERR ;UPDATES OR1 NODE "RTN","ISIIMP17",129,0) ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL "RTN","ISIIMP17",130,0) S $P(^PSRX(PSOIEN,"OR1"),"^",2)="" "RTN","ISIIMP17",131,0) S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W" "RTN","ISIIMP17",132,0) D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO) "RTN","ISIIMP17",133,0) F55 ; - File data into ^PS(55) "RTN","ISIIMP17",134,0) ;S PSODFN=DFN "RTN","ISIIMP17",135,0) S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" "RTN","ISIIMP17",136,0) F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) "RTN","ISIIMP17",137,0) S ^PS(55,PSODFN,"P",PSOX1,0)=PSOIEN,$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1) "RTN","ISIIMP17",138,0) S ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)="" "RTN","ISIIMP17",139,0) K PSOX1 "RTN","ISIIMP17",140,0) Q "RTN","ISIIMP17",141,0) F52 ;; - Re-indexing file 52 entry "RTN","ISIIMP17",142,0) K DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK "RTN","ISIIMP17",143,0) Q "RTN","ISIIMP17",144,0) ; "RTN","ISIIMP17",145,0) F525 ;UPDATE SUSPENSE FILE "RTN","ISIIMP17",146,0) Q:$G(^PSRX(PSOIEN,"STA"))'=5 "RTN","ISIIMP17",147,0) S DA=PSOIEN,X=PSOIEN,FDT=$P($G(^PSRX(PSOIEN,2)),"^",2),TYPE=$P($G(^PSRX(PSOIEN,0)),"^",11) "RTN","ISIIMP17",148,0) S DIC="^PS(52.5,",DIC(0)="L",DLAYGO=52.5,DIC("DR")=".02///"_FDT_";.03////"_$P(^PSRX(PSOIEN,0),"^",2)_";.04////"_TYPE_";.05///0;.06////"_DIV_";2///0" K DD,D0 D FILE^DICN K DD,D0 "RTN","ISIIMP17",149,0) Q "RTN","ISIIMP17",150,0) ; "RTN","ISIIMP18") 0^39^B956410 "RTN","ISIIMP18",1,0) ISIIMP18 ;ISI GROUP/MLS -- CONSULTS IMPORT API "RTN","ISIIMP18",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP18",3,0) Q "RTN","ISIIMP18",4,0) CONSULTS(ISIRESUL,ISIMISC) "RTN","ISIIMP18",5,0) N ERR,VAL "RTN","ISIIMP18",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP18",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP18",8,0) ; "RTN","ISIIMP18",9,0) ;Validate setup & parameters "RTN","ISIIMP18",10,0) S ISIRC=$$VALIDATE^ISIIMP19 Q:+ISIRC<0 ISIRC "RTN","ISIIMP18",11,0) ; "RTN","ISIIMP18",12,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP18",13,0) . ;Write out input parameters "RTN","ISIIMP18",14,0) . W !,"+++Validated ISIMISC parameters+++",! "RTN","ISIIMP18",15,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMP18",16,0) . W !,"" R X:5 "RTN","ISIIMP18",17,0) . Q "RTN","ISIIMP18",18,0) ; "RTN","ISIIMP18",19,0) ;Create patient record "RTN","ISIIMP18",20,0) S ISIRC=$$MAKECONS^ISIIMP19 Q:+ISIRC<0 ISIRC "RTN","ISIIMP18",21,0) Q ISIRC "RTN","ISIIMP19") 0^40^B1482968 "RTN","ISIIMP19",1,0) ISIIMP19 ;ISI GROUP/MLS -- CONSULTS IMPORT CONT. "RTN","ISIIMP19",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP19",3,0) Q "RTN","ISIIMP19",4,0) ; "RTN","ISIIMP19",5,0) VALIDATE() ; "RTN","ISIIMP19",6,0) ; Validate import array contents "RTN","ISIIMP19",7,0) S ISIRC=$$VALCONS^ISIIMPUB(.ISIMISC) "RTN","ISIIMP19",8,0) Q ISIRC "RTN","ISIIMP19",9,0) ; "RTN","ISIIMP19",10,0) MAKECONS() ; "RTN","ISIIMP19",11,0) ; Create patient(s) "RTN","ISIIMP19",12,0) S ISIRC=$$CONS(.ISIMISC) "RTN","ISIIMP19",13,0) Q ISIRC "RTN","ISIIMP19",14,0) ; "RTN","ISIIMP19",15,0) CONS(ISIMISC) ;Create and sign Consult entry "RTN","ISIIMP19",16,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP19",17,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP19",18,0) ; eg: ISIMISC("DFN")= 123456 "RTN","ISIIMP19",19,0) ; "RTN","ISIIMP19",20,0) ; Output - ISIRC [return code] "RTN","ISIIMP19",21,0) ; ISIRESUL(0)=1 [if successful] "RTN","ISIIMP19",22,0) ; ISIRESUL(1)="success" [if successful] "RTN","ISIIMP19",23,0) ; "RTN","ISIIMP19",24,0) N ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,ORDIALOG,ORDEA,ORAPPT,ORSRC,OREVTDF,RESULT "RTN","ISIIMP19",25,0) N ORNP,ORL,ES,ORWREC "RTN","ISIIMP19",26,0) K ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,ORDIALOG,ORDEA,ORAPPT,ORSRC,OREVTDF,RESULT "RTN","ISIIMP19",27,0) K ORNP,ORL,ES,ORWREC "RTN","ISIIMP19",28,0) ; "RTN","ISIIMP19",29,0) S ISIRC=1 "RTN","ISIIMP19",30,0) S ISIRC=$$PREP() "RTN","ISIIMP19",31,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP19",32,0) S ISIRC=$$CREATE() "RTN","ISIIMP19",33,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP19",34,0) S ISIRC=$$SIGN() "RTN","ISIIMP19",35,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP19",36,0) S ISIRESUL(0)=1 "RTN","ISIIMP19",37,0) S ISIRESUL(1)="Success" "RTN","ISIIMP19",38,0) Q ISIRC "RTN","ISIIMP19",39,0) ; "RTN","ISIIMP19",40,0) PREP() "RTN","ISIIMP19",41,0) ; "RTN","ISIIMP19",42,0) S ORVP=$G(ISIMISC("DFN")) I ORVP="" Q "-1^Missing DFN (PREP ISIIMP19)." "RTN","ISIIMP19",43,0) S ORNP=$G(ISIMISC("PROV")) I ORNP="" Q "-1^Missing PROV (PREP ISIIMP19)." "RTN","ISIIMP19",44,0) S ORL=$G(ISIMISC("LOC")) I ORL="" Q "-1^Missing LOC (PREP ISIIMP19)." "RTN","ISIIMP19",45,0) S DLG="GMRCOR CONSULT" "RTN","ISIIMP19",46,0) S ORIT=$O(^ORD(101.41,"B",DLG,"")) "RTN","ISIIMP19",47,0) I ORIT="" Q "-1^Can't locate GMRCOR CONSULT entry in #101.41 (PREP ISIIMP19)" "RTN","ISIIMP19",48,0) S ORDG=$P(^ORD(101.41,ORIT,0),U,5) "RTN","ISIIMP19",49,0) I ORDG="" Q "-1^Missing Order Dialogue value in #101.41 (PREP ISIIMP19)" "RTN","ISIIMP19",50,0) S ORIFN="" "RTN","ISIIMP19",51,0) K ORDIALOG "RTN","ISIIMP19",52,0) S ORDIALOG(4,1)=$G(ISIMISC("ORDERITEM")) I ORDIALOG(4,1)="" Q "-1^Missing ORDERITEM (PREP ISIIMP19)." ; Orderable item "RTN","ISIIMP19",53,0) S ORDIALOG(15,1)="ORDIALOG(""WP"",15,1)" "RTN","ISIIMP19",54,0) S ORDIALOG("WP",15,1,1,0)=$G(ISIMISC("TEXT")) "RTN","ISIIMP19",55,0) S ORDIALOG(10,1)="O" ;outpatient "RTN","ISIIMP19",56,0) S ORDIALOG(7,1)=9 ;URGENCY (#62.05) "RTN","ISIIMP19",57,0) S ORDIALOG(140,1)="C" ;(B:Bedside;E:Emergency Room;C:Consultant's Choice;) "RTN","ISIIMP19",58,0) S ORDIALOG(15820,1)="TODAY" ;Earliest "RTN","ISIIMP19",59,0) S ORDIALOG(20,1)="" ;Provisional Diagnosis "RTN","ISIIMP19",60,0) S ORDIALOG(173,1)="" ;Diagnosis code from above "RTN","ISIIMP19",61,0) S ORDIALOG("ORCHECK")=0 "RTN","ISIIMP19",62,0) S ORDIALOG("ORTS")=0 "RTN","ISIIMP19",63,0) S ORDEA="" "RTN","ISIIMP19",64,0) S ORAPPT="" "RTN","ISIIMP19",65,0) S ORSRC="" "RTN","ISIIMP19",66,0) S OREVTDF="" "RTN","ISIIMP19",67,0) S ES=$G(ISIMISC("ES")) I ES="" Q "-1^Missing ES (PREP ISIIMP19)." "RTN","ISIIMP19",68,0) Q 1 "RTN","ISIIMP19",69,0) ; "RTN","ISIIMP19",70,0) CREATE() "RTN","ISIIMP19",71,0) ; "RTN","ISIIMP19",72,0) S RESULT="" "RTN","ISIIMP19",73,0) D SAVE^ORWDX(.RESULT,ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,.ORDIALOG,ORDEA,ORAPPT,ORSRC,OREVTDF) "RTN","ISIIMP19",74,0) I +ISIRC<0 Q ISIRC ;in case M error "RTN","ISIIMP19",75,0) I RESULT<1 Q "-1^Unable to create consult." ;error "RTN","ISIIMP19",76,0) S ORDNO=$P(RESULT(1),U),ORDNO=+$E(ORDNO,2,$L(ORDNO)) "RTN","ISIIMP19",77,0) Q 1 "RTN","ISIIMP19",78,0) ; "RTN","ISIIMP19",79,0) SIGN() "RTN","ISIIMP19",80,0) ; "RTN","ISIIMP19",81,0) S ORWLST=0 "RTN","ISIIMP19",82,0) S ES=$$ENCRYP^XUSRB1(ES) "RTN","ISIIMP19",83,0) S ORWREC(1)=ORDNO_";1^1^1^E" "RTN","ISIIMP19",84,0) d SEND^ORWDX(ORWLST,ORVP,ORNP,ORL,ES,.ORWREC) "RTN","ISIIMP19",85,0) I +ISIRC<0 Q ISIRC ;in case M error "RTN","ISIIMP19",86,0) Q 1 "RTN","ISIIMP20") 0^42^B954833 "RTN","ISIIMP20",1,0) ISIIMP20 ;ISI GROUP/MLS -- RAD ORDERS IMPORT API "RTN","ISIIMP20",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP20",3,0) Q "RTN","ISIIMP20",4,0) RADORDER(ISIRESUL,ISIMISC) "RTN","ISIIMP20",5,0) N ERR,VAL "RTN","ISIIMP20",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP20",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP20",8,0) ; "RTN","ISIIMP20",9,0) ;Validate setup & parameters "RTN","ISIIMP20",10,0) S ISIRC=$$VALIDATE^ISIIMP21 Q:+ISIRC<0 ISIRC "RTN","ISIIMP20",11,0) ; "RTN","ISIIMP20",12,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP20",13,0) . ;Write out input parameters "RTN","ISIIMP20",14,0) . W !,"+++Validated ISIMISC parameters+++",! "RTN","ISIIMP20",15,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMP20",16,0) . W !,"" R X:5 "RTN","ISIIMP20",17,0) . Q "RTN","ISIIMP20",18,0) ; "RTN","ISIIMP20",19,0) ;Create patient record "RTN","ISIIMP20",20,0) S ISIRC=$$MAKERADO^ISIIMP21 Q:+ISIRC<0 ISIRC "RTN","ISIIMP20",21,0) Q ISIRC "RTN","ISIIMP21") 0^43^B785929 "RTN","ISIIMP21",1,0) ISIIMP21 ;ISI GROUP/MLS -- RAD ORDERS IMPORT CONT. "RTN","ISIIMP21",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMP21",3,0) Q "RTN","ISIIMP21",4,0) ; "RTN","ISIIMP21",5,0) VALIDATE() ; "RTN","ISIIMP21",6,0) ; Validate import array contents "RTN","ISIIMP21",7,0) S ISIRC=$$VALRADO^ISIIMPUC(.ISIMISC) "RTN","ISIIMP21",8,0) Q ISIRC "RTN","ISIIMP21",9,0) ; "RTN","ISIIMP21",10,0) MAKERADO() ; "RTN","ISIIMP21",11,0) ; Create patient(s) "RTN","ISIIMP21",12,0) S ISIRC=$$RADO(.ISIMISC) "RTN","ISIIMP21",13,0) Q ISIRC "RTN","ISIIMP21",14,0) ; "RTN","ISIIMP21",15,0) RADO(ISIMISC) ;Create Radiology Order "RTN","ISIIMP21",16,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP21",17,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP21",18,0) ; eg: ISIMISC("MAG_LOC")= 23 "RTN","ISIIMP21",19,0) ; "RTN","ISIIMP21",20,0) ; Output - ISIRC [return code] "RTN","ISIIMP21",21,0) ; ISIRESUL(0)=1 [if successful] "RTN","ISIIMP21",22,0) ; ISIRESUL(1)=RAOIFN [if successful] "RTN","ISIIMP21",23,0) ; "RTN","ISIIMP21",24,0) N RADFN,RAPROC,RAMLC,RADTE,RACAT,REQLOC,REQPHYS,RAREASON,RAMISC,RAOIFN "RTN","ISIIMP21",25,0) ; "RTN","ISIIMP21",26,0) S ISIRC=$$PREP() "RTN","ISIIMP21",27,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP21",28,0) ; "RTN","ISIIMP21",29,0) S ISIRC=$$CREATE() "RTN","ISIIMP21",30,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP21",31,0) ; "RTN","ISIIMP21",32,0) ; S ISIRC=$$REGISTER() "RTN","ISIIMP21",33,0) ; I +ISIRC<0 Q ISIRC "RTN","ISIIMP21",34,0) ; "RTN","ISIIMP21",35,0) ; S ISIRC=$$COMPLETE() "RTN","ISIIMP21",36,0) ; I +ISIRC<0 Q ISIRC "RTN","ISIIMP21",37,0) ; "RTN","ISIIMP21",38,0) S ISIRESUL(0)=1 "RTN","ISIIMP21",39,0) S ISIRESUL(1)=RAOIFN "RTN","ISIIMP21",40,0) Q ISIRC "RTN","ISIIMP21",41,0) ; "RTN","ISIIMP21",42,0) PREP() "RTN","ISIIMP21",43,0) ; "RTN","ISIIMP21",44,0) S RADFN=$G(ISIMISC("DFN")) I RADFN="" Q "-1^Missing RADFN (PREP ISIIMP21)." "RTN","ISIIMP21",45,0) S RAPROC=$G(ISIMISC("RAPROC")) I RAPROC="" Q "-1^Missing RAPROC (PREP ISIIMP21)." "RTN","ISIIMP21",46,0) S RAMLC=$G(ISIMISC("MAGLOC")) I RAMLC="" Q "-1^Missing MAGLOC (PREP ISIIMP21)." "RTN","ISIIMP21",47,0) S RADTE=$G(ISIMISC("RADTE")) I RADTE="" Q "-1^Missing RADTE (PREP ISIIMP21)." "RTN","ISIIMP21",48,0) S RACAT=$G(ISIMISC("EXAMCAT")) I RACAT="" Q "-1^Missing EXAMCAT (PREP ISIIMP21)." "RTN","ISIIMP21",49,0) S REQLOC=$G(ISIMISC("REQLOC")) I REQLOC="" Q "-1^Missing REQLOC (PREP ISIIMP21)." "RTN","ISIIMP21",50,0) S REQPHYS=$G(ISIMISC("PROV")) I REQPHYS="" Q "-1^Missing PROV (PREP ISIIMP21)." "RTN","ISIIMP21",51,0) S RAREASON=$G(ISIMISC("REASON")) I RAREASON="" Q "-1^Missing REASON (PREP ISIIMP21)." "RTN","ISIIMP21",52,0) K RAMISC "RTN","ISIIMP21",53,0) S RAMISC("ACLHIST",1)=ISIMISC("HISTORY") I RAMISC("ACLHIST",1)="" Q "-1^Missing HISTORY (PREP ISIIMP21)." "RTN","ISIIMP21",54,0) ;S RAMISC("PREGNANT")="N" "RTN","ISIIMP21",55,0) Q 1 "RTN","ISIIMP21",56,0) ; "RTN","ISIIMP21",57,0) CREATE() "RTN","ISIIMP21",58,0) ; "RTN","ISIIMP21",59,0) S RAOIFN=$$ORDER^RAMAG02(.RAMAG,RADFN,RAMLC,RAPROC,RADTE,RACAT,REQLOC,REQPHYS,RAREASON,.RAMISC) "RTN","ISIIMP21",60,0) I +RAOIFN<0 Q "-1^Unable to create Radiology Order (CREATE ISIIMP21)" "RTN","ISIIMP21",61,0) Q 1 "RTN","ISIIMP21",62,0) ; "RTN","ISIIMP21",63,0) REGISTER() "RTN","ISIIMP21",64,0) ; "RTN","ISIIMP21",65,0) ;Check requirements "RTN","ISIIMP21",66,0) ; N RESULTS K RESULTS "RTN","ISIIMP21",67,0) ; D EXMSTREQ^RAMAGU06(EXMSTIEN,RAPROC) "RTN","ISIIMP21",68,0) ; "RTN","ISIIMP21",69,0) N RAMISC "RTN","ISIIMP21",70,0) K RAMISC "RTN","ISIIMP21",71,0) S RAMISC("EXAMCAT")="O" ;Outpatient CATEGORY OF EXAM field (4) of sub-file #70.03 "RTN","ISIIMP21",72,0) S RAMISC("PRINCLIN")=REQLOC ; LOCATION file (#44) "RTN","ISIIMP21",73,0) S RAMISC("CLINHIST",1)=ISIMISC("HISTORY") "RTN","ISIIMP21",74,0) S RAMISC("SERVICE")=$O(^DIC(49,"B","RADIOLOGY","")) ;IEN of SERVICE/SECTION (#49) "RTN","ISIIMP21",75,0) S RAMISC("TECH")=ISIMISC("TECH") ; Technologist "RTN","ISIIMP21",76,0) S RAMISC("TECHCOMM")=ISIMISC("TECHCOM") ; Tech comments Captured." "RTN","ISIIMP21",77,0) S RAMISC("PRIMINTSTF")=REQPHYS "RTN","ISIIMP21",78,0) S X=$$REGISTER^RAMAG03(.RAMAG,.OUT,RAOIFN,RADTE,.RAMISC) "RTN","ISIIMP21",79,0) I X<0 Q "-1^Unable to register rad exam (ISIIMP21)" "RTN","ISIIMP21",80,0) ; S RADFN=$P(OUT(1),"^",1) "RTN","ISIIMP21",81,0) S RADTI=$P(OUT(1),"^",2) "RTN","ISIIMP21",82,0) S RACNI=$P(OUT(1),"^",3) "RTN","ISIIMP21",83,0) S RACASE=$P(OUT(1),"^",4) "RTN","ISIIMP21",84,0) S ACNUMB=$P(OUT(1),"^",5) "RTN","ISIIMP21",85,0) S RAINTDT=$P(OUT(1),"^",6) "RTN","ISIIMP21",86,0) Q 1 "RTN","ISIIMP21",87,0) ; "RTN","ISIIMP21",88,0) COMPLETE() "RTN","ISIIMP21",89,0) ; "RTN","ISIIMP21",90,0) ;Check requirements "RTN","ISIIMP21",91,0) ; N RESULTS K RESULTS "RTN","ISIIMP21",92,0) ; D EXMSTREQ^RAMAGU06(EXMSTIEN,RAPROC) "RTN","ISIIMP21",93,0) ; "RTN","ISIIMP21",94,0) S RACASE=RADFN_"^"_RADTI_"^"_RACNI "RTN","ISIIMP21",95,0) S RAMISC("REPORT",1)=ISIMISC("REPORT") "RTN","ISIIMP21",96,0) S RAMISC("RPTDTE")=RADTI ;Reported Date field (8) of File #74 "RTN","ISIIMP21",97,0) S RAMISC("IMPRESSION",1)=ISIMISC("IMPRESSION") "RTN","ISIIMP21",98,0) S RAMISC("CLINHIST",1)=ISIMISC("HISTORY") "RTN","ISIIMP21",99,0) S RAMISC("VERDTE")=$P(RADTE,".",1) "RTN","ISIIMP21",100,0) S RAMISC("VERPHYS")=REQPHYS "RTN","ISIIMP21",101,0) S RAMISC("PRIMDXCODE")=4 "RTN","ISIIMP21",102,0) S RAMISC("ELSIG")="" "RTN","ISIIMP21",103,0) S X=$$COMPLETE^RAMAG06(.RAMAG,RACASE,RPTDTE,.RAMISC) "RTN","ISIIMP21",104,0) I +X<0 Q "-1^Unable to complete rad exam (ISIIMP21)" "RTN","ISIIMP21",105,0) Q 1 "RTN","ISIIMPL1") 0^33^B19810262 "RTN","ISIIMPL1",1,0) ISIIMPL1 ;ISI GROUP/MLS -- LABS IMPORT Utility "RTN","ISIIMPL1",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPL1",3,0) ; "RTN","ISIIMPL1",4,0) Q "RTN","ISIIMPL1",5,0) LRZOE ;DALOI/CJS/FHS-LAB ORDER ENTRY AND ACCESSION ;12/6/06 17:45 "RTN","ISIIMPL1",6,0) ;;5.2;LAB SERVICE;**100,121,201,221,263,286**;Sep 27, 1994 "RTN","ISIIMPL1",7,0) K LRORIFN,LRNATURE,LREND,LRORDRR "RTN","ISIIMPL1",8,0) S LRLWC="WC" "RTN","ISIIMPL1",9,0) ;D EN^LRPARAM "RTN","ISIIMPL1",10,0) ;I $G(LREND) S LREND=0 Q "RTN","ISIIMPL1",11,0) L5 ; "RTN","ISIIMPL1",12,0) NEXT ;from LROE1 "RTN","ISIIMPL1",13,0) K DIR "RTN","ISIIMPL1",14,0) I $D(LROESTAT) D:$P(LRPARAM,U,14) ^LRCAPV I $G(LREND) K LRLONG,LRPANEL Q "RTN","ISIIMPL1",15,0) S (LRODT,X,DT)=$$DT^XLFDT(),LRODT0=$$FMTE^XLFDT(DT,5) "RTN","ISIIMPL1",16,0) I '$D(^LRO(69,DT,1,0)) S ^LRO(69,DT,0)=DT,^LRO(69,DT,1,0)="^69.01PA^^",^LRO(69,"B",DT,DT)="" "RTN","ISIIMPL1",17,0) ; I $D(^LAB(69.9,1,"RO")),+$H'=+$P(^("RO"),U) D ;;MLS "RTN","ISIIMPL1",18,0) ; . W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7),! ;;MLS "RTN","ISIIMPL1",19,0) ; . S DIR("A")=" Are you sure you want to continue",DIR(0)="Y",DIR("B")="No" ;;MLS "RTN","ISIIMPL1",20,0) ; I $T D ^DIR G END:$D(DIRUT) I Y'=1 W !,"OK, try later." Q ;;MLS "RTN","ISIIMPL1",21,0) S X="T-7",%DT="" D ^%DT S LRTM7=+Y "RTN","ISIIMPL1",22,0) ;W @IOF "RTN","ISIIMPL1",23,0) K DIC,LRSND,LRSN "RTN","ISIIMPL1",24,0) S (LRORD,LRZORD)=$O(^TMP("LRVEHU",$J,0)) Q:'LRORD ;; JFR "RTN","ISIIMPL1",25,0) S M9=0 ;W:0 @IOF S M9=0 G QUICK^LROE1:LRORD="" ;; MLS "RTN","ISIIMPL1",26,0) S:LRORD?.N LRORD=+LRORD IF LRORD'?.N S ISIRC="-1^Cannot locate order (ISIIMPL1)" Q ;D QMSG G NEXT ;;MLS "RTN","ISIIMPL1",27,0) ; I '$D(^LRO(69,"C",LRORD)) W !!?10,"No order exist with that number ",$C(7),! G NEXT ;;MLS "RTN","ISIIMPL1",28,0) I '$D(^LRO(69,"C",LRORD)) G NEXT ;; MLS "RTN","ISIIMPL1",29,0) S (LRCHK,LRNONE)=1,(M9,LRODT)=0 "RTN","ISIIMPL1",30,0) F S LRODT=+$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D "RTN","ISIIMPL1",31,0) . S DA=0 F S DA=$O(^LRO(69,"C",LRORD,LRODT,DA)) Q:DA<1 S LRCHK=LRCHK-1 S:LRNONE'=2 LRNONE=0 D LROE2 "RTN","ISIIMPL1",32,0) I LRNONE=2 ; W !,"The order has already been",$S(LRCHK<1:" partially",1:"")," accessioned." H 1 ;;MLS "RTN","ISIIMPL1",33,0) I LRNONE=1 S ISIRC="-1^No order exists/was created (ISIIMPL1)." Q ;W !,"No order exists with that number." H 1 G NEXT ;;MLS "RTN","ISIIMPL1",34,0) I '$$GOT(LRORD,LRODT) G NEXT "RTN","ISIIMPL1",35,0) L +^LRO(69,"C",LRORD):1 "RTN","ISIIMPL1",36,0) I '$T G NEXT ;; Try again ;; MLS "RTN","ISIIMPL1",37,0) ; I '$T W !?5,"Someone else is editing this Order",!!,$C(7) G NEXT ;;MLS "RTN","ISIIMPL1",38,0) K %DT "RTN","ISIIMPL1",39,0) S LRSTATUS="C",%DT("B")="" "RTN","ISIIMPL1",40,0) D TIME K %DT "RTN","ISIIMPL1",41,0) D:$G(LRCDT)<1 UNL69 G NEXT:LRCDT<1 "RTN","ISIIMPL1",42,0) S LRTIM=+LRCDT "RTN","ISIIMPL1",43,0) ;S:'$P(^LRO(69,LRODT,1,LRSN,0),U,8) $P(^(0),U,8)=LRTIM "RTN","ISIIMPL1",44,0) S LRUN=$P(LRCDT,U,2) K LRCDT,LRSN "RTN","ISIIMPL1",45,0) MORE ;I M9>1 K DIR S DIR("A")="Do you have the entire order",DIR(0)="Y" D ^DIR K DIR S:Y=1 M9=0 ;;MLS "RTN","ISIIMPL1",46,0) I M9>1 S M9=0 ;;MLS "RTN","ISIIMPL1",47,0) I $D(DIRUT) D UNL69 G NEXT "RTN","ISIIMPL1",48,0) S (LRODT,LRSND)=0 "RTN","ISIIMPL1",49,0) F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D "RTN","ISIIMPL1",50,0) . S LRSND=0 "RTN","ISIIMPL1",51,0) . F S LRSND=$O(^LRO(69,"C",LRORD,LRODT,LRSND)) Q:LRSND<1 D "RTN","ISIIMPL1",52,0) . . S LRSN(LRSND)=LRSND,LRSN=LRSND "RTN","ISIIMPL1",53,0) . . K LRAA D Q15^ISIIMPL4 K LRSN "RTN","ISIIMPL1",54,0) D TASK,UNL69 "RTN","ISIIMPL1",55,0) Q "RTN","ISIIMPL1",56,0) ; "RTN","ISIIMPL1",57,0) LROE2 ; "RTN","ISIIMPL1",58,0) I $D(^LRO(69,LRODT,1,DA,1)),$P(^(1),U,4)="C" S LRNONE=2,LRCHK=LRCHK+1 "RTN","ISIIMPL1",59,0) K LRSN "RTN","ISIIMPL1",60,0) S (LRSN,LRSN(DA))=+DA "RTN","ISIIMPL1",61,0) I '$D(^LRO(69,LRODT,1,LRSN,0)) Q "RTN","ISIIMPL1",62,0) S M9=$G(M9)+1,LRZX=^LRO(69,LRODT,1,LRSN,0),LRDFN=+LRZX,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX S LRWRDS=LRWRD ;W !,PNM,?30,SSN "RTN","ISIIMPL1",63,0) ;W ?45,"Requesting location: ",$P(LRZX,U,7) S Y=$P(LRZX,U,5) D DD^LRX W !,"Date/Time Ordered: ",Y,?45,"By: ",$S($D(^VA(200,+$P(LRZX,U,2),0)):$P(^(0),U),1:"") "RTN","ISIIMPL1",64,0) S LRSVSN=LRSN D ORDER^ISIIMPL3 S LRSN=LRSVSN ; JFR "RTN","ISIIMPL1",65,0) Q "RTN","ISIIMPL1",66,0) ; "RTN","ISIIMPL1",67,0) ; "RTN","ISIIMPL1",68,0) QMSG ;W !,"Enter the order entry number assigned when the test was ordered." "RTN","ISIIMPL1",69,0) ;W:'$D(LRLONG) !,"If the test has not been ordered, type the RETURN key to order the test." "RTN","ISIIMPL1",70,0) ;W !,"To exit, type the ""^"" key and RETURN key." "RTN","ISIIMPL1",71,0) Q "RTN","ISIIMPL1",72,0) ; "RTN","ISIIMPL1",73,0) ; "RTN","ISIIMPL1",74,0) YN ;R X:DTIME S:'$T DTOUT=1 Q:X=""!(X["N")!(X["Y") ;;MLS "RTN","ISIIMPL1",75,0) S X="Y" Q ;;MLS - when in doubt, say "YES" "RTN","ISIIMPL1",76,0) ;W !,"Answer 'Y' or 'N': " G YN "RTN","ISIIMPL1",77,0) ; "RTN","ISIIMPL1",78,0) ; "RTN","ISIIMPL1",79,0) TIME ;from LROE1, LRORD1 "RTN","ISIIMPL1",80,0) S %DT="ST" ;W !,"Collection Date@Time: ",$S($D(%DT("B")):%DT("B"),1:"NOW"),"//" R X:DTIME I '$T!(X="^") S LRCDT=-1 Q "RTN","ISIIMPL1",81,0) ;S:X="" X=$S($D(%DT("B")):%DT("B"),1:"N") "RTN","ISIIMPL1",82,0) S X=$G(^TMP("LRVEHU",$J,"COLL")) ; JFR stuff collection time "RTN","ISIIMPL1",83,0) I X["@U",$P(X,"@U",2)="" S X=$P(X,"@U",1) D ^%DT G TIME:Y<1 S LRCDT=+Y_"^1" Q "RTN","ISIIMPL1",84,0) S:X="U" LRCDT=DT_"^1" "RTN","ISIIMPL1",85,0) I X'="U" D ^%DT D:X'["?" TIME1 G TIME:X["?" S LRCDT=+Y_"^" G TIME:Y'["." "RTN","ISIIMPL1",86,0) Q "RTN","ISIIMPL1",87,0) ; "RTN","ISIIMPL1",88,0) TIME1 S X1=X,Y1=Y D TIME2 S X=X1,Y=Y1 K X1,Y1 "RTN","ISIIMPL1",89,0) Q "RTN","ISIIMPL1",90,0) ; "RTN","ISIIMPL1",91,0) TIME2 S X="N",%DT="ST" D ^%DT Q:Y1'>Y S %=1 ;F W !,"You have specified a collection time in the future. Are you sure" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o." "RTN","ISIIMPL1",92,0) S:%'=1 X="?" S X1=X "RTN","ISIIMPL1",93,0) Q "RTN","ISIIMPL1",94,0) ; "RTN","ISIIMPL1",95,0) ; "RTN","ISIIMPL1",96,0) TASK ; "RTN","ISIIMPL1",97,0) K LRLABLIO "RTN","ISIIMPL1",98,0) I $D(LRLABLIO),$D(LRLBL) S ZTRTN="ENT^LRLABLD",ZTDTH=$H,ZTDESC="LAB LABELS",ZTIO=LRLABLIO,ZTSAVE("LRLBL(")="" D ^%ZTLOAD "RTN","ISIIMPL1",99,0) K LRLBL "RTN","ISIIMPL1",100,0) I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ,DUZ),LRCSQ "RTN","ISIIMPL1",101,0) I $D(LRCSQ),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV "RTN","ISIIMPL1",102,0) D STOP^LRCAPV K LRCOM,LRSPCDSC,LRCCOM,LRTCOM "RTN","ISIIMPL1",103,0) Q "RTN","ISIIMPL1",104,0) ; "RTN","ISIIMPL1",105,0) ; "RTN","ISIIMPL1",106,0) GOT(ORD,ODT) ;See if all tests have been canceled "RTN","ISIIMPL1",107,0) N I,SN,ODT "RTN","ISIIMPL1",108,0) S (GOT,ODT,SN)=0 "RTN","ISIIMPL1",109,0) F S ODT=$O(^LRO(69,"C",ORD,ODT)) Q:ODT<1 D "RTN","ISIIMPL1",110,0) . S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1!(GOT) D "RTN","ISIIMPL1",111,0) . . Q:'$D(^LRO(69,ODT,1,SN,0)) "RTN","ISIIMPL1",112,0) . . S I=0 F S I=$O(^LRO(69,ODT,1,SN,2,I)) Q:I<1 I $D(^(I,0)),'$P(^(0),"^",11) S GOT=1 Q "RTN","ISIIMPL1",113,0) Q GOT "RTN","ISIIMPL1",114,0) ; "RTN","ISIIMPL1",115,0) ; "RTN","ISIIMPL1",116,0) UNL69 ; "RTN","ISIIMPL1",117,0) L -^LRO(69,"C",+$G(LRORD)) "RTN","ISIIMPL1",118,0) Q "RTN","ISIIMPL2") 0^34^B18734993 "RTN","ISIIMPL2",1,0) ISIIMPL2 ;ISI GROUP/MLS -- LABS IMPORT UTILITY "RTN","ISIIMPL2",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPL2",3,0) ; "RTN","ISIIMPL2",4,0) Q "RTN","ISIIMPL2",5,0) LRZORD1 ; "RTN","ISIIMPL2",6,0) ; "RTN","ISIIMPL2",7,0) L2 Q:$G(LREND) "RTN","ISIIMPL2",8,0) K LROT,LRSAME,LRKIL,LRGCOM,LRCCOM,LR696IEN,LRNATURE,DGSENFLG "RTN","ISIIMPL2",9,0) S LRWPC=LRWP G:$D(LROR) LRFIRST "RTN","ISIIMPL2",10,0) ;I '$D(LRADDTST) K DFN,DIC S PNM="",DIC(0)="EMQ"_$S($P(LRPARAM,U,6)&$D(LRLABKY):"L",1:"") W ! D ^LRDPA I (LRDFN=-1)!$D(DUOUT)!$D(DTOUT) Q "RTN","ISIIMPL2",11,0) K DFN,DIC,X "RTN","ISIIMPL2",12,0) S X="`"_LRZPT "RTN","ISIIMPL2",13,0) S PNM="",DIC(0)="EMQ",DGSENFLG=1 D EN^LRDPA ; JFR must default patient "RTN","ISIIMPL2",14,0) I '+DFN G DROP "RTN","ISIIMPL2",15,0) I $D(LRADDTST),LRADDTST="" Q "RTN","ISIIMPL2",16,0) S LRORDR="WC" "RTN","ISIIMPL2",17,0) S:'$D(LREND) LREND=0 I LRORDR="" S LRLWC="SP" ;D COLTY^LRWU G DROP:LREND "RTN","ISIIMPL2",18,0) ;B "RTN","ISIIMPL2",19,0) S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) "RTN","ISIIMPL2",20,0) Q12 D LOC "RTN","ISIIMPL2",21,0) Q11 D PRAC G DROP:LREND "RTN","ISIIMPL2",22,0) K T,TT,LRDMAX,LRDTST,LRTMAX "RTN","ISIIMPL2",23,0) S DA=0 "RTN","ISIIMPL2",24,0) F S DA=$O(^LRO(69,LRODT,1,"AA",LRDFN,DA)) Q:DA<1 I $S($D(^LRO(69,LRODT,1,DA,1)):$P(^(1),U,4)'="U",1:1) S S=$S($D(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0) D "RTN","ISIIMPL2",25,0) . S I=0 F S I=$O(^LRO(69,LRODT,1,DA,2,I)) Q:I<1 I $D(^(I,0)) S T(+^(0),DA)=S,X=+^(0) S:'$D(TT(X,S)) TT(X,S)=0 S TT(X,S)=TT(X,S)+1 "RTN","ISIIMPL2",26,0) K DIC "RTN","ISIIMPL2",27,0) I $D(LRADDTST) S LRORD=+LRADDTST,LRADDTST="" G LRFIRST "RTN","ISIIMPL2",28,0) D ORDER^LROW2 "RTN","ISIIMPL2",29,0) ; "RTN","ISIIMPL2",30,0) LRFIRST S LRSX=1 G Q13:'LRFIRST!(LRWP<2) "RTN","ISIIMPL2",31,0) ;W !,"Choose one (or more, separated by commas) ('*' AFTER NUMBER TO CHANGE URGENCY) " ;;MLS "RTN","ISIIMPL2",32,0) F I=1:1:LRWPD D "RTN","ISIIMPL2",33,0) . N X "RTN","ISIIMPL2",34,0) . S X=^TMP("LRSTIK",$J,"B",I) "RTN","ISIIMPL2",35,0) . ;W !,X,?4,$P(^TMP("LRSTIK",$J,X),U,2) ;;MLS "RTN","ISIIMPL2",36,0) . S X=$G(^TMP("LRSTIK",$J,"B",I+LRWPD)) "RTN","ISIIMPL2",37,0) . ;I X W ?39," ",X,?44,$P(^TMP("LRSTIK",$J,X),U,2) "RTN","ISIIMPL2",38,0) Q13 S LREDO=0 "RTN","ISIIMPL2",39,0) LEDI ; "RTN","ISIIMPL2",40,0) ; "RTN","ISIIMPL2",41,0) ; If LEDI accessioning then check for pending orders in file #69.6 "RTN","ISIIMPL2",42,0) I $G(LRRSTAT)="I",$G(LRRSITE("SMID"))'="",$G(LRSD("RUID"))'="" D I $O(LROT(0)) G BAR "RTN","ISIIMPL2",43,0) . D EN^LRORDB(LRSD("RUID"),LRRSITE("SMID")) "RTN","ISIIMPL2",44,0) G:LRWP'>1 Q13A "RTN","ISIIMPL2",45,0) ;W ! W:'LRFIRST "'?' for list, " "RTN","ISIIMPL2",46,0) S LRFIRST=0 "RTN","ISIIMPL2",47,0) ;R "TEST number(s): ",LRSX:DTIME S:LRSX["?" LRFIRST=1 G LRFIRST:LRFIRST "RTN","ISIIMPL2",48,0) S LRFIRST=1 ;MLS "RTN","ISIIMPL2",49,0) S LRSX=^TMP("LRSTIK",$J,"B","") ;MLS "RTN","ISIIMPL2",50,0) I LRSX=""!(LRSX["^") G BAR "RTN","ISIIMPL2",51,0) F I=1:1:$L(LRSX,",") D Q:LREDO "RTN","ISIIMPL2",52,0) . S LRSSX=$P(LRSX,",",I) "RTN","ISIIMPL2",53,0) . I LRSSX'?1.3N.1"*" S LREDO=1 Q "RTN","ISIIMPL2",54,0) . S LRSSX=$P(LRSSX,"*") "RTN","ISIIMPL2",55,0) . I '$D(^TMP("LRSTIK",$J,LRSSX)) S LREDO=1 "RTN","ISIIMPL2",56,0) Q13A I LREDO G Q13 ;MLS "RTN","ISIIMPL2",57,0) F LRK=1:1 S LRSSX=$P(LRSX,",",LRK) Q:LRSSX="" D "RTN","ISIIMPL2",58,0) . N X "RTN","ISIIMPL2",59,0) . S LRST=$S(LRSSX["*":1,1:0),LRSSX=+LRSSX "RTN","ISIIMPL2",60,0) . S X=^TMP("LRSTIK",$J,LRSSX) "RTN","ISIIMPL2",61,0) . S LRSAMP=$P(X,U,3),LRSPEC=$P(X,U,5),LRTSTS=+X "RTN","ISIIMPL2",62,0) . D Q20^LRORDD "RTN","ISIIMPL2",63,0) BAR ;S LRM=LRWPC+1,K=0 W !,"Other tests? N//" D % G Q14:'(%["Y") "RTN","ISIIMPL2",64,0) LRM ;D MORE^LRORD2 "RTN","ISIIMPL2",65,0) ; JFR - changed following to use stuff LRNATURE "RTN","ISIIMPL2",66,0) Q14 ;D:$P(LRPARAM,U,17) ^LRORDD D ^LRORD2A ;JFR testing the max order stuff "RTN","ISIIMPL2",67,0) S LRNATURE="4^SERVICE CORRECTION^99ORN",%=1 "RTN","ISIIMPL2",68,0) G LRM:'$D(%)&($D(LROT)'=11),DROP:$O(LROT(-1))="",LRM:'$D(%),DROP:%[U K DIC G DROP:'$D(LROT)!(%["N") "RTN","ISIIMPL2",69,0) ;W !!,"LAB Order number: ",LRORD,!! "RTN","ISIIMPL2",70,0) S ^TMP("LRVEHU",$J,LRORD)="" "RTN","ISIIMPL2",71,0) S LRZORD=LRORD "RTN","ISIIMPL2",72,0) I LRECT D G DROP:LRCDT<1 "RTN","ISIIMPL2",73,0) . I $G(LRORDRR)="R",$G(LRSD("CDT")) D Q "RTN","ISIIMPL2",74,0) . . S LRCDT=LRSD("CDT")_"^" "RTN","ISIIMPL2",75,0) . . S LRORDTIM=$P(LRSD("CDT"),".",2) "RTN","ISIIMPL2",76,0) . . I 'LRORDTIM S $P(LRCDT,"^",2)=1 "RTN","ISIIMPL2",77,0) . D TIME^LROE "RTN","ISIIMPL2",78,0) . I LRCDT<1 Q "RTN","ISIIMPL2",79,0) . S LRORDTIM=$P(Y,".",2) "RTN","ISIIMPL2",80,0) D NOW^%DTC S LRNT=% S:'LRECT LRCDT=LRNT_"^1" "RTN","ISIIMPL2",81,0) S LRIDT=9999999-LRCDT "RTN","ISIIMPL2",82,0) D ^LRORDST Q:$D(LROR) "RTN","ISIIMPL2",83,0) Q "RTN","ISIIMPL2",84,0) % S %="Y" ;***MLS MOD.*** R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G % "RTN","ISIIMPL2",85,0) ; "RTN","ISIIMPL2",86,0) Q20A ;from LRORD2 "RTN","ISIIMPL2",87,0) MAX ; CHECK FOR MAXIUM ORDER FREQUENCY "RTN","ISIIMPL2",88,0) I $D(TT(LRTSTS,LRSPEC)),$D(^LAB(60,LRTSTS,3,"B",LRCS(LRCSN))) D EN2^LRORDD I %'["Y" Q "RTN","ISIIMPL2",89,0) S I7=0 F I9=0:0 S I9=$O(T(LRTSTS,I9)) Q:I9="" I $D(^LAB(60,LRTSTS,3,+$O(^LAB(60,LRTSTS,3,"B",LRSAMP,0)),0)),+$P(^(0),U,5),LRSPEC=T(LRTSTS,I9) S I7=1 "RTN","ISIIMPL2",90,0) I I7 S LRSN=0 F S LRSN=$O(T(LRTSTS,LRSN)) Q:LRSN<1 S LRZT=LRTSTS D ORDER^LROS S LRTSTS=LRZT ;MLS "RTN","ISIIMPL2",91,0) I I7 S %="Y" Q ;D % ;MLS "RTN","ISIIMPL2",92,0) Q "RTN","ISIIMPL2",93,0) ; "RTN","ISIIMPL2",94,0) URGG ;W !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2) "RTN","ISIIMPL2",95,0) D URG^LRORD2 "RTN","ISIIMPL2",96,0) Q "RTN","ISIIMPL2",97,0) ; "RTN","ISIIMPL2",98,0) ; "RTN","ISIIMPL2",99,0) DROP ;W !!,"ORDER CANCELED",$C(7),!! "RTN","ISIIMPL2",100,0) Q:$D(LROR) G L2 "RTN","ISIIMPL2",101,0) ; "RTN","ISIIMPL2",102,0) ; "RTN","ISIIMPL2",103,0) MICRO ; "RTN","ISIIMPL2",104,0) Q "RTN","ISIIMPL2",105,0) ; "RTN","ISIIMPL2",106,0) LOC ;get pt. location, called by LRPDA1 "RTN","ISIIMPL2",107,0) N % "RTN","ISIIMPL2",108,0) I +LRDPF=LRDPF S LRDPF=LRDPF_^DIC(LRDPF,0,"GL") "RTN","ISIIMPL2",109,0) S LREND=0,LRCAPLOC="Z" "RTN","ISIIMPL2",110,0) I $G(LRLLOC)="" I $D(^LR(LRDFN,.1)) S LRLLOC=^(.1) "RTN","ISIIMPL2",111,0) ;S X="`23" ; JFR whatever location var we use ;MLS "RTN","ISIIMPL2",112,0) S X="'"_LRLLOC ;MLS "RTN","ISIIMPL2",113,0) K DIC S DIC("S")="I '$G(^(""OOS""))" "RTN","ISIIMPL2",114,0) S LROLLOC="",DIC=44,DIC(0)="MOQZ" S:X="" X=LRLLOC D ^DIC K DIC G LOC:X["?" "RTN","ISIIMPL2",115,0) S:Y>0 LROLLOC=+Y,LRLLOC=$P(Y(0),U,2),LRCAPLOC=$S($L($P(Y(0),U,3)):$P(Y(0),U,3),1:LRCAPLOC) "RTN","ISIIMPL2",116,0) I $L(LRLLOC) S ^LR(LRDFN,.1)=LRLLOC "RTN","ISIIMPL2",117,0) S ^LR(LRDFN,.092)=LRCAPLOC "RTN","ISIIMPL2",118,0) K LRIA,LRRA I $D(^SC(+Y,"I")) S LRIA=+^("I"),LRRA=$P(^("I"),U,2) "RTN","ISIIMPL2",119,0) K DIC,LRIA,LRRA,% Q "RTN","ISIIMPL2",120,0) S LREND=1 K DIC,LRIA,LRRE,% "RTN","ISIIMPL2",121,0) Q "RTN","ISIIMPL2",122,0) PRAC ; "RTN","ISIIMPL2",123,0) S LRPRAC=DUZ Q ;MLS "RTN","ISIIMPL2",124,0) Q "RTN","ISIIMPL2",125,0) QUIT S LREND=1 Q "RTN","ISIIMPL3") 0^35^B3141 "RTN","ISIIMPL3",1,0) ISIIMPL3 ;ISI GROUP/MLS -- LABS IMPORT UTILITY "RTN","ISIIMPL3",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPL3",3,0) ; "RTN","ISIIMPL3",4,0) LRZOS "RTN","ISIIMPL3",5,0) N LRLOOKUP S LRLOOKUP=1 ; Variable to indicate to lookup patients, prevent adding new entries in ^LRDPA "RTN","ISIIMPL3",6,0) EN K DIC,LRDPAF,%DT("B") S DIC(0)="A" "RTN","ISIIMPL3",7,0) D ^LRDPA G:(LRDFN=-1)!$D(DUOUT)!$D(DTOUT) LREND D L0 G EN "RTN","ISIIMPL3",8,0) L0 D ENT S %DT="" D DT^LRX "RTN","ISIIMPL3",9,0) L1 S LREND=0,%DT="E",%DT("A")="DATE to begin review: " D NOW^%DTC S Y=X G LREND:Y<1 S (LRSDT,LRODT)=Y S %DT="",X="T-"_$S($P($G(^LAB(69.9,1,0)),U,9):$P(^(0),U,9),1:30) D ^%DT S LRLDAT=Y ;MLS "RTN","ISIIMPL3",10,0) L2 S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,0)) I LRSN<1 S Y=LRODT D DD^LRX S X1=LRODT,X2=-1 D C^%DTC S LRODT=X I LRODT18 G LREND:LREND,L2:LRSN<1 "RTN","ISIIMPL3",12,0) I LRSDT'=LRODT S Y=LRODT D DD^LRX ;W Y," OK" S %=1 D YN^DICN I %'=1 G LREND "RTN","ISIIMPL3",13,0) D ENTRY G LREND:LREND S X1=LRODT,X2=-1 D C^%DTC S LRODT=X "RTN","ISIIMPL3",14,0) G L2 "RTN","ISIIMPL3",15,0) ENTRY D HED Q:LREND "RTN","ISIIMPL3",16,0) S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1!($G(LREND)) D ORDER Q:$G(LREND) D HED:$Y>(IOSL-2) "RTN","ISIIMPL3",17,0) Q "RTN","ISIIMPL3",18,0) ORDER ;call with LRSN, from LROE, LROE1, LRORD1, LROW2, LROR1 ;;;;JFR changed to eliminate writes "RTN","ISIIMPL3",19,0) K D,LRTT S LREND=0 "RTN","ISIIMPL3",20,0) Q:'$D(^LRO(69,LRODT,1,LRSN,0)) S LROD0=^LRO(69,LRODT,1,LRSN,0),LROD1=$S($D(^(1)):^(1),1:""),LROD3=$S($D(^(3)):^(3),1:"") "RTN","ISIIMPL3",21,0) S X=$P(LROD0,U,6) D DOC^LRX "RTN","ISIIMPL3",22,0) S X=$P(LROD0,U,3),X=$S(X:$S($D(^LAB(62,+X,0)):$P(^(0),U),1:""),1:""),X4="" I $D(^LRO(69,LRODT,1,LRSN,4,1,0)),+^(0) S X4=+^(0),X4=$S($D(^LAB(61,X4,0)):$P(^(0),U),1:"") "RTN","ISIIMPL3",23,0) I $E($P(LROD1,U,6))="*" ;W !?3,$P(LROD1,U,6) D WAIT Q:$G(LREND) "RTN","ISIIMPL3",24,0) F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1!($G(LREND)) ;W !?5,": ",^(I,0) D WAIT Q:$G(LREND) "RTN","ISIIMPL3",25,0) S LRACN=0 F S LRACN=$O(^LRO(69,LRODT,1,LRSN,2,LRACN)) Q:LRACN<1!($G(LREND)) I $D(^(LRACN,0))#2 S LRACN0=^(0) D TEST "RTN","ISIIMPL3",26,0) Q "RTN","ISIIMPL3",27,0) TEST N LRY,LRURG "RTN","ISIIMPL3",28,0) S LRROD=$P(LRACN0,U,6),(Y,LRLL,LROT,LROS,LROSD,LRURG)="",X3=0 "RTN","ISIIMPL3",29,0) I $P(LRACN0,"^",11) G CANC "RTN","ISIIMPL3",30,0) S X=$P(LROD0,U,4),LROT=$S(X="WC":"Requested (WARD COL)",X="SP":"Requested (SEND PATIENT)",X="LC":"Requested (LAB COL)",X="I":"Requested (IMM LAB COL)",1:"undetermined") "RTN","ISIIMPL3",31,0) S X=$P(LROD1,U,4),(LROOS,LROS)=$S(X="C":"Collected",X="U":"Uncollected, cancelled",1:"On Collection List") S:X="C" LROT="" "RTN","ISIIMPL3",32,0) I '(+LRACN0) D WAIT Q ;MLS "RTN","ISIIMPL3",33,0) G NOTACC:LROD1="" ;,NOTACC:$P(LROD1,"^",4)="U" "RTN","ISIIMPL3",34,0) TST1 S X1=+$P(LRACN0,U,4),X2=+$P(LRACN0,U,3),X3=+$P(LRACN0,U,5) "RTN","ISIIMPL3",35,0) G NOTACC:'$D(^LRO(68,X1,1,X2,1,X3,0)),NOTACC:'$D(^(3)) S LRACD=$S($D(^(9)):^(9),1:"") "RTN","ISIIMPL3",36,0) I '$D(LRTT(X1,X2,X3)) S LRTT(X1,X2,X3)="",I=0 F S I=$O(^LRO(68,X1,1,X2,1,X3,4,I)) Q:I<.5!($G(LREND)) S LRACC=^(I,0),LRTSTS=+LRACC D TST2 "RTN","ISIIMPL3",37,0) I $E($P(LROD1,U,6))="*" D WAIT ;MLS "RTN","ISIIMPL3",38,0) Q "RTN","ISIIMPL3",39,0) TST2 ; "RTN","ISIIMPL3",40,0) N I "RTN","ISIIMPL3",41,0) S LRURG=+$P(LRACC,U,2) I LRURG>49 Q "RTN","ISIIMPL3",42,0) I 'LRTSTS S ISIRC="-1^Internal VistA error: bad accession test pointer (ISIIMPL3)" Q ;W !!,"BAD ACCESSION TEST POINTER: ",LRTSTS Q "RTN","ISIIMPL3",43,0) S LROT="",LROS=LROOS,LRLL=$P(LRACC,U,3),Y=$P(LRACC,U,5) I Y S LROS=$S($E($P(LRACC,U,6))="*":$P(LRACC,U,6),1:"Test Complete") D DATE S LROSD=Y Q ;D WRITE,COM(1.1),COM(1) "RTN","ISIIMPL3",44,0) S Y=$P(LROD3,U) D DATE S LROSD=Y I LRLL S LROS="Testing In Progress" "RTN","ISIIMPL3",45,0) I $P(LROD1,"^",4)="U" S (LROS,LROOS)="" "RTN","ISIIMPL3",46,0) ;D WRITE,COM(1.1),COM(1) "RTN","ISIIMPL3",47,0) Q "RTN","ISIIMPL3",48,0) WRITE ; "RTN","ISIIMPL3",49,0) ;W !?2,$S($D(^LAB(60,+LRTSTS,0)):$P(^(0),U),1:"BAD TEST POINTER") "RTN","ISIIMPL3",50,0) ;I $X>20 D WAIT Q:(LREND) ;MLS "RTN","ISIIMPL3",51,0) ;W ?20,$S($D(^LAB(62.05,+LRURG,0)):$P(^(0),U),1:"")," " D WAIT Q:$G(LREND) "RTN","ISIIMPL3",52,0) ;I $X>28 W ! D WAIT Q:$G(LREND) "RTN","ISIIMPL3",53,0) ;W ?28,LROT," ",LROS,?43," ",LROSD "RTN","ISIIMPL3",54,0) ;W:X3 ?60," ",$S($D(^LRO(68,X1,1,X2,1,X3,.2)):^(.2),1:"") "RTN","ISIIMPL3",55,0) ;I LRROD W !?46," See order: ",LRROD D WAIT "RTN","ISIIMPL3",56,0) Q "RTN","ISIIMPL3",57,0) COM(LRMMODE) ; "RTN","ISIIMPL3",58,0) ;Write comments "RTN","ISIIMPL3",59,0) ;LRMMODE=comments node to display "RTN","ISIIMPL3",60,0) N LRTSTI "RTN","ISIIMPL3",61,0) S:'$G(LRMMODE) LRMMODE=1 "RTN","ISIIMPL3",62,0) S LRTSTI=$O(^LRO(69,LRODT,1,LRSN,2,"B",+LRTSTS,0)) Q:'LRTSTI "RTN","ISIIMPL3",63,0) D COMWRT(LRODT,LRSN,LRTSTI,LRMMODE,3) "RTN","ISIIMPL3",64,0) Q "RTN","ISIIMPL3",65,0) COMWRT(LRODT,LRSN,LRTSTI,NODE,TAB) ; "RTN","ISIIMPL3",66,0) ;Write comment node "RTN","ISIIMPL3",67,0) I $S('LRODT:1,'LRSN:1,'LRTSTI:1,'NODE:1,1:0) Q "RTN","ISIIMPL3",68,0) Q:'$D(^LRO(69,LRODT,1,LRSN,2,LRTSTI)) "RTN","ISIIMPL3",69,0) S:'$G(TAB) TAB=3 "RTN","ISIIMPL3",70,0) N LRI "RTN","ISIIMPL3",71,0) S LRI=0 F S LRI=$O(^LRO(69,LRODT,1,LRSN,2,LRTSTI,NODE,LRI)) Q:LRI<1!($G(LREND)) ;W:$D(^(LRI,0)) !?TAB,": "_^(0) D WAIT "RTN","ISIIMPL3",72,0) Q "RTN","ISIIMPL3",73,0) NOTACC I $G(LROD3)="" S LROS="" G NO2 "RTN","ISIIMPL3",74,0) I $P(LROD3,U,2)'="" S LROS=" ",Y=$P(LROD3,U,2) G NO2 "RTN","ISIIMPL3",75,0) S Y=$P(LROD3,U) S LROS=" " "RTN","ISIIMPL3",76,0) NO2 S:'Y Y=$P(LROD0,U,8) S Y=$S(Y:Y,+LROD3:+LROD3,+LROD1:+LROD1,1:LRODT) D DATE S LROSD=Y "RTN","ISIIMPL3",77,0) S LRTSTS=+LRACN0,LRURG=$P(LRACN0,U,2) "RTN","ISIIMPL3",78,0) S LROS=$S(LRROD:"Combined",1:LROS) S:LROS="" LROS="for: " "RTN","ISIIMPL3",79,0) I LRTSTS ;D WRITE,COM(1.1),COM(1) ;second call for backward compatibility - can be removed in future years (1/98) "RTN","ISIIMPL3",80,0) ;I $L($P(LROD1,U,6)) W !,?20,$P(LROD1,U,6) D WAIT ;; JFR eliminate writes "RTN","ISIIMPL3",81,0) Q "RTN","ISIIMPL3",82,0) DATE S Y=$$FMTE^XLFDT(Y,"5MZ") Q "RTN","ISIIMPL3",83,0) HED D WAIT:$E(IOST,1)="C"&($Y>18) Q:$G(LREND) ;W @IOF,!," Test",?20,"Urgency",?30,"Status",?64,"Accession" "RTN","ISIIMPL3",84,0) ENT ;from LROE, LROE1, LRORD1, LROW2 "RTN","ISIIMPL3",85,0) Q "RTN","ISIIMPL3",86,0) LREND I $E(IOST)="P" ;W @IOF "RTN","ISIIMPL3",87,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","ISIIMPL3",88,0) K LRLDAT,LRURG,LROSD,LRTT,LROS,LROOS,LRROD,X1,X2,X3,%,A,DFN,DIC,I,K,LRACC,LRACN,LRACN0,LRDFN,LRDOC,LRDPF,LREND,LRLL,LROD0,LROD1,LROD3,LRODT,LROT,LRSDT,LRSN,LRTSTS,X,X4,Y,Z,%Y,DIWL,DIWR,DPF,PNM Q "RTN","ISIIMPL3",89,0) SHOW ;call with LRSN,LRODT, from LRCENDEL, LRTSTJAN "RTN","ISIIMPL3",90,0) S LREND=0 "RTN","ISIIMPL3",91,0) ;W !,"Order Test",?20,"Urgency",?30,"Status",?64,"Accession" ;MLS "RTN","ISIIMPL3",92,0) D ORDER Q "RTN","ISIIMPL3",93,0) WAIT Q:$Y<(IOSL-3) I $E(IOST)'="C" Q ;W @IOF Q ;MLS "RTN","ISIIMPL3",94,0) ;W !," PRESS '^' TO STOP " R X:DTIME "RTN","ISIIMPL3",95,0) S X=1 S LREND=".^"[X Q:$G(LREND) ;W @IOF "RTN","ISIIMPL3",96,0) Q "RTN","ISIIMPL3",97,0) CANC ;For Canceled tests "RTN","ISIIMPL3",98,0) S LRTSTS=+$G(LRACN0),LROT="*Canceled by: "_$P(^VA(200,$P(LRACN0,"^",11),0),U) "RTN","ISIIMPL3",99,0) I LRTSTS ;D WRITE,COM(1.1),COM(1) ;second call for backward compatitility - can be removed in future years (1/98) "RTN","ISIIMPL3",100,0) Q "RTN","ISIIMPL3",101,0) OERR(X) ;Get order status for predefined patient "RTN","ISIIMPL3",102,0) ;X=DFN;DPT( <--ORVP FORMAT "RTN","ISIIMPL3",103,0) I '$G(X) S ISIRC="-1^Internal VistA error: patient not found (ISIIMPL3)" Q ;W !!?5,"NO PATIENT SELECTED",! H 2 Q "RTN","ISIIMPL3",104,0) N DFN,LRDPA,LRDFN,LRDT0,VA200 "RTN","ISIIMPL3",105,0) S DFN=+X,LRDPF=+$P(@("^"_$P(X,";",2)_"0)"),"^",2)_"^"_$P(X,";",2) "RTN","ISIIMPL3",106,0) D END^LRDPA "RTN","ISIIMPL3",107,0) Q:LRDFN=-1 "RTN","ISIIMPL3",108,0) ;W !,"Lab test status for: "_$P(^DPT(DFN,0),"^") "RTN","ISIIMPL3",109,0) D L0 "RTN","ISIIMPL3",110,0) Q "RTN","ISIIMPL4") 0^36^B3150 "RTN","ISIIMPL4",1,0) ISIIMPL4 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL4",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPL4",3,0) ; "RTN","ISIIMPL4",4,0) LRZOE2 "RTN","ISIIMPL4",5,0) ;Formerly a part of LROE1 "RTN","ISIIMPL4",6,0) Q15 ;from LROE1 "RTN","ISIIMPL4",7,0) Q:'$D(^LRO(69,LRODT,1,LRSN,0)) "RTN","ISIIMPL4",8,0) I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^(1),"^",4)="U" S ^(1)=LRTIM_"^^"_DUZ,DA=LRSN,DA(1)=LRODT,DIE="^LRO(69,"_DA(1)_",1,",DR=16 D ^DIE ;MLS "RTN","ISIIMPL4",9,0) I M9>1 D LRSPEC^LROE1 S S1=$S($D(^LAB(61,+LRSPEC,0)):$P(^(0),U),1:""),S2=$P(^LAB(62,LRSAMP,0),U),S4=$P(^(0),U,3),S3=S1_$S(S1'=S2:" "_S2,1:"") ;W !,"Do you have the ",S3," ",S4 K S1,S2,S3,S4 S %=2 D YN^DICN G Q15:%=0 Q:%'=1 "RTN","ISIIMPL4",10,0) S DA=DT,LRDFN=+^LRO(69,LRODT,1,LRSN,0),LRDPF=+$P(^LR(LRDFN,0),U,2) "RTN","ISIIMPL4",11,0) IF '$D(^LRO(69,LRODT,1,LRSN,1)) S LRSTATUS="C",DA=LRODT I '$D(LRSND) D P15^LROE1 Q:LRCDT<1 "RTN","ISIIMPL4",12,0) I $D(LRSND),$P(^LRO(69,LRODT,1,LRSN,0),U,4)="LC",$D(^(1)) S LRLLOC=$P(^(0),U,7),LROLLOC=$P(^(0),U,9),LRNT=$S($D(LRNT):LRNT,$D(LRTIM):LRTIM,$D(LRCDT):+LRCDT,1:"") D P15^LRPHITEM G PH "RTN","ISIIMPL4",13,0) I $D(LRSND) N COMB S COMB=$P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7) S ^LRO(69,LRODT,1,LRSN,1)=LRTIM_"^"_LRUN_"^"_DUZ_"^"_LRSTATUS_"^^^"_COMB_"^"_DUZ(2) S:LRSTATUS="C" ^LRO(69,"AA",+$G(^LRO(69,LRODT,1,LRSN,.1)),LRODT_"|"_LRSN)="" "RTN","ISIIMPL4",14,0) PH G Q16:LRORD D ORDER^LROW2 G Q16A "RTN","ISIIMPL4",15,0) Q16 S J=0 D CHECK^LROW2 I J D BAD^LROW2 "RTN","ISIIMPL4",16,0) Q16A I $D(LRLONG),$D(LRSND) S LRSN=LRSND,^TMP("LROE",$J,"LRORD")=LRORD_U_LRODT_U_LRTIM_U_PNM_U_SSN "RTN","ISIIMPL4",17,0) K DR S LRTSTS=0 "RTN","ISIIMPL4",18,0) S LRSN=0 F S LRSN=$O(LRSN(LRSN)) Q:'LRSN D Q17 "RTN","ISIIMPL4",19,0) I $D(LRLONG),$D(LRSND) S LRSN=LRSND D LROE S X=^TMP("LROE",$J,"LRORD"),LRORD=+X,LRODT=$P(X,"^",2),LRTIM=$P(X,"^",3),LRLONG="",PNM=$P(X,"^",4),SSN=$P(X,"^",5) "RTN","ISIIMPL4",20,0) Q "RTN","ISIIMPL4",21,0) Q17 S I=$O(^LRO(69,LRODT,1,LRSN,6,0)),J=$O(^(1)) S:'$D(IOM) IOM=80 K LRSPCDSC S:J LRSPCDSC=^(J,0) S:I DA=LRSN,DA(1)=LRODT,DR=6,DIC="^LRO(69,"_LRODT_",1," D EN^DIQ:I D LRSPEC^LROE1 "RTN","ISIIMPL4",22,0) D OLD^LRORDST K ^TMP("LR",$J,"TMP") "RTN","ISIIMPL4",23,0) S $P(^LRO(69,LRODT,1,LRSN,1),U,4)="C",$P(^LRO(69,LRODT,1,LRSN,1),U,8)=DUZ(2),^LRO(69,"AA",+$G(^LRO(69,LRODT,1,LRSN,.1)),LRODT_"|"_LRSN)="" "RTN","ISIIMPL4",24,0) Q "RTN","ISIIMPL4",25,0) LROE ;from LROE1 ;;;;JFR copied from LRFAST to reduce mods "RTN","ISIIMPL4",26,0) S LRLLOC=$P(^LRO(69,LRODT,1,LRSN,0),U,7) S:'$L(LRLLOC) LRLLOC=0 K LROE "RTN","ISIIMPL4",27,0) S I1=0 F S I1=$O(^LRO(69,LRODT,1,LRSN,2,I1)) Q:I1<1!($G(LREND)) S X=^(I1,0) I $P(X,U,4) S LRAA=$P(X,U,4),LRAN=$P(X,U,5),LRAD=$P(X,U,3) I '$D(LROE(LRAD_LRAA_LRAN)) S LROE(LRAD_LRAA_LRAN)="" D LROE1 "RTN","ISIIMPL4",28,0) G QUIT^LRFAST "RTN","ISIIMPL4",29,0) ; "RTN","ISIIMPL4",30,0) ; "RTN","ISIIMPL4",31,0) LROE1 S LRX=$G(^LRO(68,LRAA,0)) "RTN","ISIIMPL4",32,0) S LRIDIV=$S($L($P(LRX,U,19)):$P(LRX,U,19),1:"CP") "RTN","ISIIMPL4",33,0) D:$P(LRPARAM,U,14)&($P($G(^LRO(68,LRAA,0)),U,16)) ^LRCAPV "RTN","ISIIMPL4",34,0) I $G(LREND) Q "RTN","ISIIMPL4",35,0) ; Check for different performing lab. "RTN","ISIIMPL4",36,0) I $G(LRPL) N LRDUZ S LRDUZ(2)=LRPL "RTN","ISIIMPL4",37,0) ; "RTN","ISIIMPL4",38,0) S LRUID=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),"^") "RTN","ISIIMPL4",39,0) I $P(LRX,U,2)="CH" D ^ISIIMPL5 ;D ^LRZVER1 "RTN","ISIIMPL4",40,0) K LRX "RTN","ISIIMPL4",41,0) Q "RTN","ISIIMPL4",42,0) ; "RTN","ISIIMPL5") 0^44^B31496059 "RTN","ISIIMPL5",1,0) ISIIMPL5 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL5",2,0) ;;1.0;;;JUN 26,2012;Build 30 "RTN","ISIIMPL5",3,0) ; "RTN","ISIIMPL5",4,0) LRZVER1 ;DALOI/FHS-LAB ROUTINE DATA VERIFICATION ; 12/7/06 08:48 "RTN","ISIIMPL5",5,0) ;;5.2;LAB SERVICE;**42,153,201,215,239,240,263,232,286**;Sep 27, 1994 "RTN","ISIIMPL5",6,0) ; "RTN","ISIIMPL5",7,0) VER ; from LRGVP "RTN","ISIIMPL5",8,0) S LRLLOC=0,LRCW=8,LROUTINE=$P(^LAB(69.9,1,3),U,2) I $D(^LRO(69,LRODT,1,LRSN,0)) S LRLLOC=$P(^(0),U,7) S:'$L(LRLLOC) LRLLOC=0 ; W !,$P(^LRO(69,LRODT,1,LRSN,1),U,6) ;***MLS MOD.*** "RTN","ISIIMPL5",9,0) S LRCDT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):$P(^(3),U,1,2),1:$P(^(0),U,3)_U),LREAL=$P(LRCDT,U,2) "RTN","ISIIMPL5",10,0) S LRCDT=+LRCDT,LRSAMP=$S($D(^LRO(69,LRODT,1,LRSN,0)):$P(^(0),U,3),1:"") "RTN","ISIIMPL5",11,0) S LRIDT=$S($P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5):$P(^(3),U,5),1:"") "RTN","ISIIMPL5",12,0) S:'LRIDT LRIDT=9999999-LRCDT "RTN","ISIIMPL5",13,0) D EXP "RTN","ISIIMPL5",14,0) LD S LRSS="CH" ;ONLY WORKS FOR 'CH' "RTN","ISIIMPL5",15,0) S LRMETH=LRSS IF $D(^LR(LRDFN,LRSS,LRIDT,0)) S LRMETH=$P($P(^(0),U,8),";",1) "RTN","ISIIMPL5",16,0) ;W:$D(^LAB(62,+LRSAMP,0)) !,"Sample: ",$P(^(0),U) "RTN","ISIIMPL5",17,0) K ^TMP("LR",$J,"TMP"),LRORD,LRM "RTN","ISIIMPL5",18,0) D ^ISIIMPL6 ;D ^LRZVER2 "RTN","ISIIMPL5",19,0) K LRDL "RTN","ISIIMPL5",20,0) Q "RTN","ISIIMPL5",21,0) ; "RTN","ISIIMPL5",22,0) ; "RTN","ISIIMPL5",23,0) EXP ; Get the list of tests for this ACC. from LRGVG1 "RTN","ISIIMPL5",24,0) ; Do not process tests which have been "NP" (not performed). "RTN","ISIIMPL5",25,0) N I,N,IX,LRNLT,T1,X "RTN","ISIIMPL5",26,0) K LRTEST,LRNAME,LRSM60 "RTN","ISIIMPL5",27,0) S LRALERT=LROUTINE,N=0,I=0,IX=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)) "RTN","ISIIMPL5",28,0) F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<.5 D "RTN","ISIIMPL5",29,0) . S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)) "RTN","ISIIMPL5",30,0) . I 'X Q "RTN","ISIIMPL5",31,0) . I $P(X,"^",6)="*Not Performed" Q "RTN","ISIIMPL5",32,0) . S N=N+1,LRTEST(N)=I,LRNLT=$S($P(X,"^",2)>50:$P(X,U,9),1:$P(X,"^")) "RTN","ISIIMPL5",33,0) . S LRTEST(N,"P")=LRNLT_U_$$NLT(LRNLT) "RTN","ISIIMPL5",34,0) . S LRAL=$P(X,U,2)#50 "RTN","ISIIMPL5",35,0) . I LRAL S LRALERT=$S(LRALLRTM60 LRLDT=-1 G V8:LRLDT=-1,V7:'$D(^LR(LRDFN,LRSS,LRLDT,0)) D V9 G:$P(^LR(LRDFN,LRSS,LRLDT,0),U,5)'=LRSPEC!'$P(^(0),U,3)!'$D(LRMA) V7 "RTN","ISIIMPL6",27,0) V8 S LRDAT(2)="",Z2="" I LRLDT>0 S Z2=^LR(LRDFN,"CH",LRLDT,0),X=+Z2,Z=Z2 D DAT S LRDAT(2)=LRDAT "RTN","ISIIMPL6",28,0) S Z1=^LR(LRDFN,"CH",LRIDT,0),X=+Z1,Z=Z1 D DAT "RTN","ISIIMPL6",29,0) Q "RTN","ISIIMPL6",30,0) DAT N LRX "RTN","ISIIMPL6",31,0) S LRX=$$FMTE^XLFDT(X,"5M") "RTN","ISIIMPL6",32,0) S LRDAT=$P(LRX,"/",1,2)_" "_$P(LRX,"@",2)_$S($P(Z,U,2)!(X'["."):"r",1:"d") Q "RTN","ISIIMPL6",33,0) V9 K LRMA S I=0 F S I=$O(^TMP("LR",$J,"TMP",I)) Q:I<1 I $D(^LR(LRDFN,LRSS,LRLDT,I)) S LRMA=1 Q "RTN","ISIIMPL6",34,0) Q "RTN","ISIIMPL7") 0^46^B51775765 "RTN","ISIIMPL7",1,0) ISIIMPL7 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL7",2,0) ;;1.0;;;JUN 26,2012;Build 30 "RTN","ISIIMPL7",3,0) ; "RTN","ISIIMPL7",4,0) LRZVER3 ;DALOI/CJS/FHS-DATA VERIFICATION ; 12/7/06 08:56 "RTN","ISIIMPL7",5,0) ;;5.2;LAB SERVICE;**42,100,121,140,171,153,221,286**;Sep 27, 1994 "RTN","ISIIMPL7",6,0) ; "RTN","ISIIMPL7",7,0) D V1 "RTN","ISIIMPL7",8,0) I $D(LRLOCKER)#2 L -@(LRLOCKER) K LRLOCKER "RTN","ISIIMPL7",9,0) Q "RTN","ISIIMPL7",10,0) ; "RTN","ISIIMPL7",11,0) ; "RTN","ISIIMPL7",12,0) V1 I $D(LRLOCKER)#2 L -@(LRLOCKER) "RTN","ISIIMPL7",13,0) S LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")" "RTN","ISIIMPL7",14,0) L +@(LRLOCKER):1 "RTN","ISIIMPL7",15,0) I '$T Q ;***MLS MOD. *** W !," This entry is being edited by someone else." Q "RTN","ISIIMPL7",16,0) I $D(LRGVP) S X="1-"_LRNTN D RANGE^LRWU2 G L10 "RTN","ISIIMPL7",17,0) S LRALL="",LRALERT=LROUTINE,LRLCT=6 "RTN","ISIIMPL7",18,0) ; "RTN","ISIIMPL7",19,0) ; List any not performed tests. "RTN","ISIIMPL7",20,0) S I=0 "RTN","ISIIMPL7",21,0) F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 D "RTN","ISIIMPL7",22,0) . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)) "RTN","ISIIMPL7",23,0) . I $P(LRX,"^",6)'="*Not Performed" Q "RTN","ISIIMPL7",24,0) . ;***MLS MOD. *** W !,?3,$P(^LAB(60,I,0),"^"),?25," ",$P(LRX,"^",6) "RTN","ISIIMPL7",25,0) . S LRLCT=LRLCT+1 D:LRLCT>22 WT^ISIIMPL8 ;WT^LRVER4 "RTN","ISIIMPL7",26,0) ; "RTN","ISIIMPL7",27,0) ; No tests to edit "RTN","ISIIMPL7",28,0) I LRNTN=0 D COM^LRVR4 G EXIT "RTN","ISIIMPL7",29,0) ; "RTN","ISIIMPL7",30,0) F I=1:1:LRNTN I $D(LRNAME(I)) D "RTN","ISIIMPL7",31,0) . S LRALL=LRALL_","_I ;***MLS MOD.*** W !,I," ",LRNAME(I) "RTN","ISIIMPL7",32,0) . I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0))#2 D "RTN","ISIIMPL7",33,0) . . S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0) "RTN","ISIIMPL7",34,0) . . S LRAL=$P(LRX,U,2)#50 "RTN","ISIIMPL7",35,0) . . I $P(LRX,U,5) ;***MLS MOD.*** W ?25,$S($P(LRX,U,6)'="":$P(LRX,U,6),1:" verified") "RTN","ISIIMPL7",36,0) . . I LRAL S LRALERT=$S(LRAL22 WT^ISIIMPL8 ;WT^LRVER4 "RTN","ISIIMPL7",38,0) ; "RTN","ISIIMPL7",39,0) I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D "RTN","ISIIMPL7",40,0) . ;***MLS MOD.*** W !?15 W:IOST["C-" @LRVIDO "RTN","ISIIMPL7",41,0) . ;***MLS MOD.*** W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U) "RTN","ISIIMPL7",42,0) . ;***MLS MOD.*** W:IOST["C-" @LRVIDOF W !,$C(7) "RTN","ISIIMPL7",43,0) ; "RTN","ISIIMPL7",44,0) S X9="" I LRNTN=1 S T1=1 G L10 "RTN","ISIIMPL7",45,0) V9 S LRALL=$P(LRALL,",",2,99) "RTN","ISIIMPL7",46,0) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X["A" X=LRALL "RTN","ISIIMPL7",47,0) I X["?" G V9 ;***MLS MOD.*** W !,"Enter for example 1,2,5-9." G V9 "RTN","ISIIMPL7",48,0) Q:X[U!(X="") D RANGE^LRWU2 G EXIT:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") G EXIT:X=0 "RTN","ISIIMPL7",49,0) L10 ; "RTN","ISIIMPL7",50,0) N LRCORECT S LRCORECT=0 "RTN","ISIIMPL7",51,0) S LRNX=0 X (X9_"D EX1^ISIIMPL5") ;(X9_"D EX1^LRZVER1") "RTN","ISIIMPL7",52,0) D V7^ISIIMPL6 ;D V7^LRZVER2 "RTN","ISIIMPL7",53,0) S LRCMTDSP=$$CHKCDSP^LRVERA "RTN","ISIIMPL7",54,0) K LRSA,LRSB,LRORU3 "RTN","ISIIMPL7",55,0) F LRSB=1:0 S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:LRSB<1 D "RTN","ISIIMPL7",56,0) . S LRSB(LRSB)=^(LRSB),LRSB(LRSB,"P")=$P(LRSB(LRSB),U,3) "RTN","ISIIMPL7",57,0) . I $D(LRNOVER) S LRNOVER(LRSB)="" "RTN","ISIIMPL7",58,0) S LREDIT=1 "RTN","ISIIMPL7",59,0) D ^ISIIMPL8 ;D ^LRZVER4 ; JFR edited "RTN","ISIIMPL7",60,0) ; "RTN","ISIIMPL7",61,0) ; If group data review then quit before updating results "RTN","ISIIMPL7",62,0) I $D(LRGVP) G EXIT "RTN","ISIIMPL7",63,0) ; "RTN","ISIIMPL7",64,0) I '$O(LRORD(0)) G EXIT "RTN","ISIIMPL7",65,0) I '$G(LRCHG),'LRVF F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 S:LRSB(LRSB)'="" ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB) "RTN","ISIIMPL7",66,0) I $G(LRCHG) D CHG K LRCHG,LRUP I $G(LREND) S LREND=0 G EXIT "RTN","ISIIMPL7",67,0) ; "RTN","ISIIMPL7",68,0) I $D(LRSA),$D(LRF) K LRF S X=$P(^LR(LRDFN,LRSS,LRIDT,0),U,9) S:$L(X)&($E(X)'["-") $P(^(0),U,9)="-"_X G V11 "RTN","ISIIMPL7",69,0) G EXIT:$D(LRGVP),V11:LRVF&$D(LRSA),V1:LRVF&(LRNTN>1),EXIT:LRVF "RTN","ISIIMPL7",70,0) ; "RTN","ISIIMPL7",71,0) NOVER I $O(LRNOVER(0)) D G EXIT "RTN","ISIIMPL7",72,0) . F I=0:0 S I=+$O(LRNOVER(I)) Q:I<2 ;***MLS MOD.*** W !,"Test Not Reviewed: ",$P(^DD(63.04,I,0),U) W:$D(LRSB(I))#2 " = "_$P(LRSB(I),U)_" "_$P(LRSB(I),U,2) "RTN","ISIIMPL7",73,0) . ;***MLS MOD.*** W !,$$CJ^XLFSTR("The above test(s) have results already entered,",80) "RTN","ISIIMPL7",74,0) . ;***MLS MOD.*** W !,$$CJ^XLFSTR("but you did not select them for review.",80) "RTN","ISIIMPL7",75,0) . ;***MLS MOD.*** W !,$$CJ^XLFSTR(" Accession NOT approved. ",80),$C(7) "RTN","ISIIMPL7",76,0) . ;***MLS MOD.*** W !,$$CJ^XLFSTR("You must review all results before ANY can be released.",80),!! "RTN","ISIIMPL7",77,0) . ;***MLS MOD.*** W:$E(IOST,1,2)="C-" @LRVIDO W $$CJ^XLFSTR("Suggest you select 'ALL' tests for verification/review. ",80) W:$E(IOST,1,2)="C-" @LRVIDOF W !,$C(7) "RTN","ISIIMPL7",78,0) I $O(LRNOVER(0)) G EXIT ;***MLS MOD.*** W !,"Has not been reviewed and has data. Not approved.",! G EXIT "RTN","ISIIMPL7",79,0) I '$P($G(LRLABKY),U) G EXIT ;***MLS MOD.*** W !,$C(7),"ENTERED BUT NOT APPROVED",! G EXIT "RTN","ISIIMPL7",80,0) I '$O(LRSB(0)) G EXIT ;***MLS MOD.*** W !?5,"Nothing verified ",$C(7),! G EXIT "RTN","ISIIMPL7",81,0) N CNT S CNT=1 "RTN","ISIIMPL7",82,0) AGAIN ; "RTN","ISIIMPL7",83,0) I '$D(^TMP("LRVEHU",$J,"I")) R !,"Approve for release by entering your initials: ",LRINI:DTIME ;; JFR - changed "RTN","ISIIMPL7",84,0) I $D(^TMP("LRVEHU",$J,"I")) S LRINI=^("I") ; JFR - added "RTN","ISIIMPL7",85,0) I '$D(LRINI) S LRINI="^" "RTN","ISIIMPL7",86,0) I $E(LRINI)="^" D READ G EXIT ;***MLS MOD.*** W !!?5,$C(7),"Nothing verified!" D READ G EXIT "RTN","ISIIMPL7",87,0) I LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI "RTN","ISIIMPL7",88,0) I $S($E(LRINI)="?":1,LRINI'=LRUSI&(CNT<2):1,1:0) S:$E(LRINI)="?" CNT=0 S CNT=CNT+1 G AGAIN ;***MLS MOD.*** "RTN","ISIIMPL7",89,0) ;***MLS MOD.*** W !," Verified!" "RTN","ISIIMPL7",90,0) I LRINI'=LRUSI D READ G EXIT ;***MLS MOD.*** "RTN","ISIIMPL7",91,0) V11 I $D(XRTL) D T0^%ZOSV ; START RESPONSE TIME LOGGING "RTN","ISIIMPL7",92,0) D VER^LRVER3A "RTN","ISIIMPL7",93,0) I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1 "RTN","ISIIMPL7",94,0) N LRX "RTN","ISIIMPL7",95,0) S LRX=0 "RTN","ISIIMPL7",96,0) F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 S:'$D(^LRO(68,"AC",LRDFN,LRIDT,LRX)) ^(LRX)="" I LRVF S ^(LRX)="" "RTN","ISIIMPL7",97,0) I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3 "RTN","ISIIMPL7",98,0) I $D(XRT0) S XRTN="V11^LRVER3" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING "RTN","ISIIMPL7",99,0) S LRVF=1 "RTN","ISIIMPL7",100,0) Q "RTN","ISIIMPL7",101,0) ; "RTN","ISIIMPL7",102,0) ; "RTN","ISIIMPL7",103,0) EXIT Q "RTN","ISIIMPL7",104,0) ; "RTN","ISIIMPL7",105,0) ; "RTN","ISIIMPL7",106,0) READ ; "RTN","ISIIMPL7",107,0) ;***MLS MOD.*** N X W !!,"Press ENTER or RETURN to continue: " R X:DTIME "RTN","ISIIMPL7",108,0) Q "RTN","ISIIMPL7",109,0) ; "RTN","ISIIMPL7",110,0) ; "RTN","ISIIMPL7",111,0) CHG ; Check for changes, save results and create audit trail "RTN","ISIIMPL7",112,0) S LRUP="" "RTN","ISIIMPL7",113,0) F S LRCHG=$O(LRSB(LRCHG)) Q:LRCHG<1 D "RTN","ISIIMPL7",114,0) . I '$D(LRSA(LRCHG)) S LRUP=1 Q "RTN","ISIIMPL7",115,0) . I $P(LRSA(LRCHG),"^")=""!($P(LRSA(LRCHG),"^")="pending") S LRUP=1 Q "RTN","ISIIMPL7",116,0) . I $P(LRSA(LRCHG),"^")'=$P(LRSB(LRCHG),"^") S LRUP=1,$P(LRSA(LRCHG,2),"^")=1 ; results changed "RTN","ISIIMPL7",117,0) . I $P(LRSA(LRCHG),"^",2)'=$P(LRSB(LRCHG),"^",2) S LRUP=1,$P(LRSA(LRCHG,2),"^",2)=1 ; normalcy flag changed "RTN","ISIIMPL7",118,0) . I $P(LRSA(LRCHG),"^",5)'=$P(LRSB(LRCHG),"^",5) D ; units/normals changed "RTN","ISIIMPL7",119,0) . . N LRX,LRY "RTN","ISIIMPL7",120,0) . . S LRX=$$UP^XLFSTR($P(LRSA(LRCHG),"^",5)),LRX=$TR(LRX,"""") "RTN","ISIIMPL7",121,0) . . S LRY=$$UP^XLFSTR($P(LRSB(LRCHG),"^",5)),LRY=$TR(LRY,"""") "RTN","ISIIMPL7",122,0) . . I LRX'=LRY S LRUP=1,$P(LRSA(LRCHG,2),"^",5)=1 "RTN","ISIIMPL7",123,0) I 'LRUP S LREND=1 Q "RTN","ISIIMPL7",124,0) S LREND=0 "RTN","ISIIMPL7",125,0) ;***MLS MOD.*** W !! W:IOST["C-" @LRVIDO W "Approve update of data by entering your initials: " W:IOST["C-" @LRVIDOF "RTN","ISIIMPL7",126,0) R LRINI:DTIME "RTN","ISIIMPL7",127,0) I '$T S LREND=1 "RTN","ISIIMPL7",128,0) I 'LREND,LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI "RTN","ISIIMPL7",129,0) I LRINI'=LRUSI S LREND=1 "RTN","ISIIMPL7",130,0) I LREND Q ;***MLS MOD.*** W !,$C(7),"No updating occurred ",! Q "RTN","ISIIMPL7",131,0) ; "RTN","ISIIMPL7",132,0) F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 D "RTN","ISIIMPL7",133,0) . K:'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) LRSA(LRSB) "RTN","ISIIMPL7",134,0) . S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB) "RTN","ISIIMPL7",135,0) . I $D(LRSA(LRSB,1)),$D(LRSA(LRSB,2)) D DIDLE "RTN","ISIIMPL7",136,0) ;***MLS MOD.*** W !! "RTN","ISIIMPL7",137,0) Q "RTN","ISIIMPL7",138,0) ; "RTN","ISIIMPL7",139,0) ; "RTN","ISIIMPL7",140,0) DIDLE ; "RTN","ISIIMPL7",141,0) ; Check if no previous result or pending result - no audit trail needed "RTN","ISIIMPL7",142,0) I $P(LRSA(LRSB),"^")=""!($P(LRSA(LRSB),"^")="pending") Q "RTN","ISIIMPL7",143,0) ; "RTN","ISIIMPL7",144,0) S LRF=1 "RTN","ISIIMPL7",145,0) L +^LR(LRDFN,LRSS,LRIDT):999 "RTN","ISIIMPL7",146,0) NOW S LRNOW7=$$NOW^XLFDT "RTN","ISIIMPL7",147,0) ;***MLS MOD.*** W ! "RTN","ISIIMPL7",148,0) D ^LRDIDLE0 "RTN","ISIIMPL7",149,0) I 'LROK K LRSA "RTN","ISIIMPL7",150,0) L -^LR(LRDFN,LRSS,LRIDT) "RTN","ISIIMPL7",151,0) S LRCORECT=1 "RTN","ISIIMPL7",152,0) Q "RTN","ISIIMPL7",153,0) ; "RTN","ISIIMPL7",154,0) ; "RTN","ISIIMPL7",155,0) RONLT ; (R)esolve (O)rder NLT code from file #68 original ordered test or "RTN","ISIIMPL7",156,0) ; use default when not specified for file #60 test. "RTN","ISIIMPL7",157,0) ; "RTN","ISIIMPL7",158,0) N LR60,LRX,LRY,X "RTN","ISIIMPL7",159,0) S LR60=+LRTS,LRY=$P(LRSB(LRSB),U,3) "RTN","ISIIMPL7",160,0) ; "RTN","ISIIMPL7",161,0) ; Try to determine order NLT from original ordered test "RTN","ISIIMPL7",162,0) F Q:'LR60 D "RTN","ISIIMPL7",163,0) . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60,0)),LR60=+$P(LRX,"^",9) "RTN","ISIIMPL7",164,0) . I LR60,LR60'=$P(LRX,"^") D "RTN","ISIIMPL7",165,0) . . S X=$$NLT^LRVER1(LR60) "RTN","ISIIMPL7",166,0) . . I X'="" S $P(LRY,"!")=X "RTN","ISIIMPL7",167,0) . I LR60=$P(LRX,"^") S LR60=0 "RTN","ISIIMPL7",168,0) ; "RTN","ISIIMPL7",169,0) ; Otherwise use default for lab package "RTN","ISIIMPL7",170,0) I $P(LRY,"!")="" S $P(LRY,"!")=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,LRY,+LRSPEC),"!") "RTN","ISIIMPL7",171,0) ; "RTN","ISIIMPL7",172,0) S $P(LRSB(LRSB),U,3)=LRY "RTN","ISIIMPL7",173,0) ; "RTN","ISIIMPL7",174,0) Q "RTN","ISIIMPL7",175,0) ; "RTN","ISIIMPL7",176,0) ; "RTN","ISIIMPL7",177,0) LRORU3 ; "RTN","ISIIMPL7",178,0) SET ; "RTN","ISIIMPL7",179,0) N LR64,LR7V,LRDN,LROTA,LRT,LRTPN,LRTPNN,LRTYPE,X "RTN","ISIIMPL7",180,0) ; "RTN","ISIIMPL7",181,0) ; Go through LRSB array and sort results by order NLT code "RTN","ISIIMPL7",182,0) ; and put into ordered test array (LROTA). "RTN","ISIIMPL7",183,0) S LRDN=0 "RTN","ISIIMPL7",184,0) F S LRDN=$O(LRSB(LRDN)) Q:'LRDN D "RTN","ISIIMPL7",185,0) . I $P(LRSB(LRDN),"^")="" Q "RTN","ISIIMPL7",186,0) . S LRTPNN=$P($P(LRSB(LRDN),U,3),"!"),LRT=+$G(^TMP("LR",$J,"TMP",LRDN)) "RTN","ISIIMPL7",187,0) . I LRTPNN="" Q "RTN","ISIIMPL7",188,0) . S LRTYPE=$P($G(^LAB(60,LRT,0)),U,3) "RTN","ISIIMPL7",189,0) . I LRTYPE=""!("OB"'[LRTYPE) Q "RTN","ISIIMPL7",190,0) . S LROTA(LRTPNN,LRDN)=LRT "RTN","ISIIMPL7",191,0) . I $D(LRSA(LRDN,2)) S LROTA(LRTPNN,LRDN,1)="C" "RTN","ISIIMPL7",192,0) ; "RTN","ISIIMPL7",193,0) ; For each order NLT code setup call to put results into #62.49 queue "RTN","ISIIMPL7",194,0) S LRTPNN="" "RTN","ISIIMPL7",195,0) F S LRTPNN=$O(LROTA(LRTPNN)) Q:LRTPNN="" D "RTN","ISIIMPL7",196,0) . S LR64=+$O(^LAM("C",LRTPNN_" ",0)),LRTPN=$$GET1^DIQ(64,LR64_",",.01) "RTN","ISIIMPL7",197,0) . K LR7V "RTN","ISIIMPL7",198,0) . M LR7V=LROTA(LRTPNN) "RTN","ISIIMPL7",199,0) . D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LRTPN,LRTPNN,LRIDT,LRSS,LRDFN,LRODT,.LR7V) "RTN","ISIIMPL7",200,0) Q "RTN","ISIIMPL8") 0^47^B84134788 "RTN","ISIIMPL8",1,0) ISIIMPL8 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL8",2,0) ;;1.0;;;JUN 26,2012;Build 30 "RTN","ISIIMPL8",3,0) ; "RTN","ISIIMPL8",4,0) LRZVER4 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ;12/7/06 09:05 "RTN","ISIIMPL8",5,0) ;;5.2;LAB SERVICE;**14,42,112,121,140,171,153,188,279,283,286**;Sep 27, 1994 "RTN","ISIIMPL8",6,0) ; "RTN","ISIIMPL8",7,0) N LRAMEND,LRRFLAG "RTN","ISIIMPL8",8,0) ; "RTN","ISIIMPL8",9,0) LOOP ; "RTN","ISIIMPL8",10,0) S LRLCT=0 "RTN","ISIIMPL8",11,0) I '$D(LRGVP) D "RTN","ISIIMPL8",12,0) . S:$D(LRWRDS) LRWRD=LRWRDS "RTN","ISIIMPL8",13,0) . ;W !!,PNM," SSN: ",SSN," " S LRLCT=LRLCT+1 "RTN","ISIIMPL8",14,0) . ;I LRDPF=2 W " LOC: ",$S(LRWRD'="":LRWRD,1:$S($L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)):$P(^(0),U,7),1:"??")) "RTN","ISIIMPL8",15,0) ; "RTN","ISIIMPL8",16,0) ;W !,"Pat Info: ",$P($G(^LR(LRDFN,.091)),U) "RTN","ISIIMPL8",17,0) ;W ?34," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:SEX) "RTN","ISIIMPL8",18,0) ;W ?48," Age: ",$$CALCAGE^LRRPU(DOB,LRCDT)," as of ",$$FMTE^XLFDT(LRCDT,"1D") "RTN","ISIIMPL8",19,0) S LRPRAC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,8) "RTN","ISIIMPL8",20,0) I LRPRAC>0,LRPRAC=+LRPRAC D GETS^DIQ(200,LRPRAC_",",".01;.132;.137;.138","E","LRPRAC(LRPRAC)","LRERR") "RTN","ISIIMPL8",21,0) ;W !,"Provider: " "RTN","ISIIMPL8",22,0) S LRLCT=LRLCT+2 "RTN","ISIIMPL8",23,0) ;I LRPRAC'="",'$D(LRPRAC(LRPRAC,200)) W LRPRAC "RTN","ISIIMPL8",24,0) I LRPRAC,$D(LRPRAC(LRPRAC,200)) ; D ; JFR changed "RTN","ISIIMPL8",25,0) . ;W LRPRAC(LRPRAC,200,LRPRAC_",",.01,"E"),?40," Voice pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.137,"E") "RTN","ISIIMPL8",26,0) . ;W !," Phone: ",LRPRAC(LRPRAC,200,LRPRAC_",",.132,"E"),?38," Digital pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.138,"E") "RTN","ISIIMPL8",27,0) . S LRLCT=LRLCT+1 "RTN","ISIIMPL8",28,0) ; "RTN","ISIIMPL8",29,0) N PRAC,PR "RTN","ISIIMPL8",30,0) D PRAC^LR7OMERG(LRAA,LRAD,LRAN,.PRAC) "RTN","ISIIMPL8",31,0) I $O(PRAC(0)) D "RTN","ISIIMPL8",32,0) . S PR=0 "RTN","ISIIMPL8",33,0) . F S PR=$O(PRAC(PR)) Q:PR<1 I $D(^VA(200,PR,0)) S LRLCT=LRLCT+1 ;***MLS MOD.*** W !?14,$P(^(0),"^") S LRLCT=LRLCT+1 "RTN","ISIIMPL8",34,0) S LRLCT=LRLCT+1 ;**MLS MOD.***W ! S LRLCT=LRLCT+1 "RTN","ISIIMPL8",35,0) S LRNX=0,LRVRM=2,T="" "RTN","ISIIMPL8",36,0) I $P(^LR(LRDFN,LRSS,LRIDT,0),U,7)'="" D "RTN","ISIIMPL8",37,0) . ;W !,"VOLUME: ",$P(^(0),U,7) "RTN","ISIIMPL8",38,0) . S LRLCT=LRLCT+1 "RTN","ISIIMPL8",39,0) S LRACC=$P(Z1,U,6) "RTN","ISIIMPL8",40,0) I '$G(LRZONE) D "RTN","ISIIMPL8",41,0) . ;W !,"ACCESSION:",?30,$P(Z2,U,6),?44," ",LRACC "RTN","ISIIMPL8",42,0) . ;W !,?30,LRDAT(2) W ?44," ",LRDAT "RTN","ISIIMPL8",43,0) . S LRZONE=+$G(LRZONE)+2 "RTN","ISIIMPL8",44,0) S LRLCT=LRLCT+2 "RTN","ISIIMPL8",45,0) I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D "RTN","ISIIMPL8",46,0) . ;W !?15 W:$E(IOST,1,2)="C-" @LRVIDO "RTN","ISIIMPL8",47,0) . ;W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U) "RTN","ISIIMPL8",48,0) . ;W:$E(IOST,1,2)="C-" @LRVIDOF,$C(7) "RTN","ISIIMPL8",49,0) . S LRLCT=LRLCT+1 "RTN","ISIIMPL8",50,0) ; "RTN","ISIIMPL8",51,0) I '$O(LRORD(0)) Q ;W !!?7,$C(7),"This is not a verifiable test/accession ",! Q "RTN","ISIIMPL8",52,0) V I $D(LRGVP) D V20 Q "RTN","ISIIMPL8",53,0) G EDIT:($O(^LR(LRDFN,LRSS,LRIDT,1))=""!('LRVF&$D(LRPER)))&'$D(LRNUF) "RTN","ISIIMPL8",54,0) K LRNUF "RTN","ISIIMPL8",55,0) D V20,ND G V37:LRVF&'$D(X)#2,EDIT:LREDIT "RTN","ISIIMPL8",56,0) S LRTEC=$S($D(^LRO(68,LRAA,1,LRAD,2)):$P(^(2),U),1:$S($D(LRUSI):LRUSI,1:"")),LREDIT=0 "RTN","ISIIMPL8",57,0) V36 ; "RTN","ISIIMPL8",58,0) Q:$D(LRGVP) "RTN","ISIIMPL8",59,0) Q ;;JFR added to remove edit ability "RTN","ISIIMPL8",60,0) K DIR "RTN","ISIIMPL8",61,0) S DIR(0)="SAO^E:Edit;C:Comments;W:Workload" "RTN","ISIIMPL8",62,0) S DIR("A")="SELECT ('E' to Edit, 'C' for Comments, 'W' Workload): " "RTN","ISIIMPL8",63,0) D ^DIR "RTN","ISIIMPL8",64,0) I $D(DIRUT) S X="^" G V37 "RTN","ISIIMPL8",65,0) S X=Y "RTN","ISIIMPL8",66,0) S:$E(X)="E" LREDIT=1,X="" "RTN","ISIIMPL8",67,0) K LRNC "RTN","ISIIMPL8",68,0) I $E(X)="C" S LRNC=1 D COM K LRNC G V36 "RTN","ISIIMPL8",69,0) I $E(X)="W" D G LOOP "RTN","ISIIMPL8",70,0) . I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D STD^LRCAPV,EN^LRCAPV S LREND=0 Q "RTN","ISIIMPL8",71,0) . ;W !?10," Workload is not activated." "RTN","ISIIMPL8",72,0) S X=$S(X="@":"",X="":LRTEC,1:X),LRTEC=X "RTN","ISIIMPL8",73,0) S:'$D(^LRO(68,LRAA,1,LRAD,2)) ^(2)="" S ^(2)=X_U_$P(^(2),U,2,99) "RTN","ISIIMPL8",74,0) G EDIT:LREDIT "RTN","ISIIMPL8",75,0) V37 Q ;LEAVE LRVER4, BACK TO LRVER3 "RTN","ISIIMPL8",76,0) ; "RTN","ISIIMPL8",77,0) ; "RTN","ISIIMPL8",78,0) V20 ; "RTN","ISIIMPL8",79,0) I $G(LRCHG) D V21,DCOM^LRVERA Q "RTN","ISIIMPL8",80,0) S LRNX=$O(LRORD(LRNX)) G V35:LRNX<1 D SUBS "RTN","ISIIMPL8",81,0) G:'$G(LRTS) V20 "RTN","ISIIMPL8",82,0) I '$D(LRSB(LRSB)),'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) G V20 "RTN","ISIIMPL8",83,0) ;D V25^LRVER5 "RTN","ISIIMPL8",84,0) D V25^ISIIMPL9 "RTN","ISIIMPL8",85,0) ; "RTN","ISIIMPL8",86,0) D:$D(LRGVP) PG Q:$D(LRGVP)&($D(DTOUT)!$D(DUOUT)) "RTN","ISIIMPL8",87,0) ; "RTN","ISIIMPL8",88,0) ;W !,$P(^LAB(60,+LRTS,0),U) "RTN","ISIIMPL8",89,0) S X1="" "RTN","ISIIMPL8",90,0) I $D(^LR(LRDFN,LRSS,+LRLDT,LRSB)) D "RTN","ISIIMPL8",91,0) . S X1=$P(^(LRSB),U),X=X1 "RTN","ISIIMPL8",92,0) . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","ISIIMPL8",93,0) . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",X1) "RTN","ISIIMPL8",94,0) . . I X="" S X=X1 "RTN","ISIIMPL8",95,0) . ;W:X'="" ?30,@LRFP "RTN","ISIIMPL8",96,0) S (X,LRFLG)="" "RTN","ISIIMPL8",97,0) I $D(LRSB(LRSB)) D "RTN","ISIIMPL8",98,0) . N LRX "RTN","ISIIMPL8",99,0) . K LRNOVER(LRSB) "RTN","ISIIMPL8",100,0) . S (LRDL,LRX,X)=$P(LRSB(LRSB),U) "RTN","ISIIMPL8",101,0) . S LREDIT=0,LRFLG=$P(LRSB(LRSB),U,2) "RTN","ISIIMPL8",102,0) . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","ISIIMPL8",103,0) . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",LRX) "RTN","ISIIMPL8",104,0) . . I X="" S X=LRX "RTN","ISIIMPL8",105,0) . ;W ?44," ",@LRFP," ",LRFLG,?56," ",$P($P(LRSB(LRSB),U,5),"!",7) ;$P(LRNG,U,7) "RTN","ISIIMPL8",106,0) . S X=LRX "RTN","ISIIMPL8",107,0) . I X=""!(X="canc")!(X="comment")!(X="pending") Q "RTN","ISIIMPL8",108,0) . S Y=0 "RTN","ISIIMPL8",109,0) . I LRDEL'="" S LRQ=1 X LRDEL K LRQ "RTN","ISIIMPL8",110,0) . ;W " " "RTN","ISIIMPL8",111,0) . I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG "RTN","ISIIMPL8",112,0) ; "RTN","ISIIMPL8",113,0) S:$P(X,U)="" $P(LRSB(LRSB),U)="" "RTN","ISIIMPL8",114,0) I $P(X,U)'="" D "RTN","ISIIMPL8",115,0) . N I,LRX,LRY "RTN","ISIIMPL8",116,0) . S $P(LRSB(LRSB),U)=X,$P(LRSB(LRSB),U,2)=LRFLG "RTN","ISIIMPL8",117,0) . S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3) "RTN","ISIIMPL8",118,0) . F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I) "RTN","ISIIMPL8",119,0) . S $P(LRSB(LRSB),U,3)=LRY "RTN","ISIIMPL8",120,0) . I $P($P(LRSB(LRSB),U,3),"!")="" D RONLT^LRVER3 "RTN","ISIIMPL8",121,0) . D "RTN","ISIIMPL8",122,0) . . I $P(LRSB(LRSB),U,4)!($P(LRSB(LRSB),U)="pending") Q "RTN","ISIIMPL8",123,0) . . I '$D(LRSA(LRSB))#2 S $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)),$P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"") Q "RTN","ISIIMPL8",124,0) . . I $P(LRSB(LRSB),U)=$P(LRSA(LRSB),U) S:$P(LRSA(LRSB),U,4) $P(LRSB(LRSB),U,4)=$P(LRSA(LRSB),U,4) S $P(LRSA(LRSB),U,3)=$P(LRSB(LRSB),U,3) Q "RTN","ISIIMPL8",125,0) . . S:'$P(LRSB(LRSB),U,4) $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)),$P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"") "RTN","ISIIMPL8",126,0) . S $P(LRSB(LRSB),U,5)=$TR(LRNGS,U,"!") "RTN","ISIIMPL8",127,0) I '$D(LRNUF) S LRLCT=LRLCT+1 S:$X>80 LRLCT=LRLCT+1 D:LRLCT>22 WT G:$G(Y)'="^" V20 "RTN","ISIIMPL8",128,0) ; "RTN","ISIIMPL8",129,0) V35 ; "RTN","ISIIMPL8",130,0) D LRCFL:LRCFL]"" "RTN","ISIIMPL8",131,0) D DCOM^LRVERA K LRNUF "RTN","ISIIMPL8",132,0) Q "RTN","ISIIMPL8",133,0) ; "RTN","ISIIMPL8",134,0) ; "RTN","ISIIMPL8",135,0) LRCFL ; "RTN","ISIIMPL8",136,0) S LREXEC=LRCFL D ^LREXEC:LRCFL["" "RTN","ISIIMPL8",137,0) D:LRLCT>22 WT "RTN","ISIIMPL8",138,0) Q "RTN","ISIIMPL8",139,0) ; "RTN","ISIIMPL8",140,0) ; "RTN","ISIIMPL8",141,0) EDIT ; "RTN","ISIIMPL8",142,0) K LROUT "RTN","ISIIMPL8",143,0) D ^ISIIMPL9 S LRVRM=2 G:$G(LRCHG) LOOP G LRCFL:$D(LROUT)!$D(LRPER) "RTN","ISIIMPL8",144,0) G LOOP "RTN","ISIIMPL8",145,0) ; "RTN","ISIIMPL8",146,0) ; "RTN","ISIIMPL8",147,0) RANGE ; "RTN","ISIIMPL8",148,0) N LRI,LRFIND "RTN","ISIIMPL8",149,0) S Y=X "RTN","ISIIMPL8",150,0) I X=""!(X="canc")!(X="comment")!(X="pending") Q "RTN","ISIIMPL8",151,0) ;W " " "RTN","ISIIMPL8",152,0) F LRI=1:1:$L(X) S LRFIND=$E(X,LRI) Q:LRFIND?1(1N,1A,1".",1"-",1"<",1">") "RTN","ISIIMPL8",153,0) S X=$E(X,LRI,999) "RTN","ISIIMPL8",154,0) ; "RTN","ISIIMPL8",155,0) ; User has indicated specific normality to set - used when entering "RTN","ISIIMPL8",156,0) ; reference lab results and all the info to calculate is not available. "RTN","ISIIMPL8",157,0) I $G(LRRFLAG(LRSB)) S LRFLG=$P("L^L*^H^H*","^",LRRFLAG(LRSB)) "RTN","ISIIMPL8",158,0) ; "RTN","ISIIMPL8",159,0) E D RANGECHK "RTN","ISIIMPL8",160,0) I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG "RTN","ISIIMPL8",161,0) RQ S X=Y "RTN","ISIIMPL8",162,0) Q "RTN","ISIIMPL8",163,0) ; "RTN","ISIIMPL8",164,0) ; "RTN","ISIIMPL8",165,0) RANGECHK ; Check result against reference ranges and set flag "RTN","ISIIMPL8",166,0) ; "RTN","ISIIMPL8",167,0) ; "RTN","ISIIMPL8",168,0) ; Check for numeric abnormal results "RTN","ISIIMPL8",169,0) I X?.1"-".N.1".".N D Q "RTN","ISIIMPL8",170,0) . I LRNG4'="",LRNG4?.1"-".N.1".".N,XLRNG5 S LRFLG="H*" Q "RTN","ISIIMPL8",172,0) . I LRNG2'="",LRNG2?.1"-".N.1".".N,XLRNG3 S LRFLG="H" Q "RTN","ISIIMPL8",174,0) ; "RTN","ISIIMPL8",175,0) ; Check for <> abnormal results "RTN","ISIIMPL8",176,0) ; "<" results checked against low values "RTN","ISIIMPL8",177,0) ; ">" results checked against high values "RTN","ISIIMPL8",178,0) I X?1(1"<",1">").N.1".".N D Q "RTN","ISIIMPL8",179,0) . N LRX "RTN","ISIIMPL8",180,0) . S LRX=$E(X,2,$L(X)) "RTN","ISIIMPL8",181,0) . I $E(X)="<" D Q "RTN","ISIIMPL8",182,0) . . I LRNG4'="",LRNG4?.N.1".".N,LRXLRNG5 S LRFLG="H*" Q "RTN","ISIIMPL8",188,0) . . I LRNG5'="",LRNG5?.N.1".".N,LRX=LRNG5 S LRFLG="H*" Q "RTN","ISIIMPL8",189,0) . . I LRNG3'="",LRNG3?.N.1".".N,LRX>LRNG3 S LRFLG="H" Q "RTN","ISIIMPL8",190,0) . . I LRNG3'="",LRNG3?.N.1".".N,LRX=LRNG3 S LRFLG="H" Q "RTN","ISIIMPL8",191,0) ; "RTN","ISIIMPL8",192,0) ; Check for ranges, i.e. 0-5, 6-10. "RTN","ISIIMPL8",193,0) ; Compare first value to abnormal value "RTN","ISIIMPL8",194,0) I X?1.N1"-"1.N D Q "RTN","ISIIMPL8",195,0) . I LRNG4'="",LRNG4?.N.1".".N,+XLRNG5 S LRFLG="H*" Q "RTN","ISIIMPL8",197,0) . I LRNG2'="",LRNG2?.N.1".".N,+XLRNG3 S LRFLG="H" Q "RTN","ISIIMPL8",199,0) ; "RTN","ISIIMPL8",200,0) Q "RTN","ISIIMPL8",201,0) ; "RTN","ISIIMPL8",202,0) ; "RTN","ISIIMPL8",203,0) DISPFLG ; Display critical flags "RTN","ISIIMPL8",204,0) ; "RTN","ISIIMPL8",205,0) Q ; JFR no need for flashing on a VEHU stuff "RTN","ISIIMPL8",206,0) I $E(IOST,1,2)="C-" ;***MLS MOD.*** W $C(7),@LRVIDO "RTN","ISIIMPL8",207,0) ;W "CRITICAL ",$S($E(LRFLG,1)="L":"LOW",$E(LRFLG,1)="H":"HIGH",1:""),"!!" "RTN","ISIIMPL8",208,0) I $E(IOST,1,2)="C-" ;***MLS MOD.*** W @LRVIDOF,$C(7),$C(7) "RTN","ISIIMPL8",209,0) Q "RTN","ISIIMPL8",210,0) ; "RTN","ISIIMPL8",211,0) ; "RTN","ISIIMPL8",212,0) SUBS ; "RTN","ISIIMPL8",213,0) S LRSB=LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB)):^(LRSB),1:0) "RTN","ISIIMPL8",214,0) Q "RTN","ISIIMPL8",215,0) ; "RTN","ISIIMPL8",216,0) ; "RTN","ISIIMPL8",217,0) ND ; "RTN","ISIIMPL8",218,0) K X,DIR "RTN","ISIIMPL8",219,0) Q:'LRVF "RTN","ISIIMPL8",220,0) I '$P($G(LRLABKY),U) D Q "RTN","ISIIMPL8",221,0) . ;W !,"You're not authorized to edit verified data." "RTN","ISIIMPL8",222,0) . S LREDIT=0 "RTN","ISIIMPL8",223,0) S DIR(0)="FO" "RTN","ISIIMPL8",224,0) S DIR("A")="If you need to change something, enter your initials" "RTN","ISIIMPL8",225,0) S DIR("?")="To change verified results, enter your initials." "RTN","ISIIMPL8",226,0) D ^DIR "RTN","ISIIMPL8",227,0) S X=Y K DIR "RTN","ISIIMPL8",228,0) I $$UP^XLFSTR(X)'=$$UP^XLFSTR(LRUSI) S LREDIT=0 K X QUIT "RTN","ISIIMPL8",229,0) I $D(X)#2,'$G(LRCHG) D S LRCHG=1 ;**MLS MOD.*** W ! D S LRCHG=1 "RTN","ISIIMPL8",230,0) . K LRSA S LRSA=1 "RTN","ISIIMPL8",231,0) . F S LRSA=$O(^LR(LRDFN,"CH",LRIDT,LRSA)) Q:'LRSA S LRSA(LRSA)=^(LRSA) "RTN","ISIIMPL8",232,0) Q "RTN","ISIIMPL8",233,0) ; "RTN","ISIIMPL8",234,0) ; "RTN","ISIIMPL8",235,0) WT S LRLCT=0 Q:$D(LRGVP) "RTN","ISIIMPL8",236,0) ;W !,"PRESS ANY KEY TO CONTINUE, '^' TO STOP " R Y:DTIME S:'$T Y="^" "RTN","ISIIMPL8",237,0) Q "RTN","ISIIMPL8",238,0) ; "RTN","ISIIMPL8",239,0) ; "RTN","ISIIMPL8",240,0) COM ;from LRVER5 "RTN","ISIIMPL8",241,0) Q:$D(LRGVP) "RTN","ISIIMPL8",242,0) K DR "RTN","ISIIMPL8",243,0) S DIE="^LR("_LRDFN_",""CH"",",DA=LRIDT,DA(1)=LRDFN,DR=.99 "RTN","ISIIMPL8",244,0) D ^DIE,COM1:$D(LRNC) "RTN","ISIIMPL8",245,0) L +^LR(LRDFN,LRSS,LRIDT):5 "RTN","ISIIMPL8",246,0) I $O(^LR(LRDFN,"CH",LRIDT,1,0))="" K ^LR(LRDFN,"CH",LRIDT,1) "RTN","ISIIMPL8",247,0) L -^LR(LRDFN,LRSS,LRIDT) "RTN","ISIIMPL8",248,0) Q "RTN","ISIIMPL8",249,0) ; "RTN","ISIIMPL8",250,0) ; "RTN","ISIIMPL8",251,0) VOL ; "RTN","ISIIMPL8",252,0) ;W !,"VOLUME: ",$P(^LR(LRDFN,LRSS,LRIDT,0),U,7),"//" R X:DTIME "RTN","ISIIMPL8",253,0) G VOL:X["?" S:X'=""&(X'[U) ^(0)=$P(^(0),U,1,6)_U_X_U_$P(^(0),U,8,10) "RTN","ISIIMPL8",254,0) G COM "RTN","ISIIMPL8",255,0) ; "RTN","ISIIMPL8",256,0) ; "RTN","ISIIMPL8",257,0) COM1 ; "RTN","ISIIMPL8",258,0) N LRX Q:'$P(^LR(LRDFN,LRSS,LRIDT,0),U,3) "RTN","ISIIMPL8",259,0) D XREF^LRVER3A "RTN","ISIIMPL8",260,0) S LRX=0 F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 S ^LRO(68,"AC",LRDFN,LRIDT,LRX)="" "RTN","ISIIMPL8",261,0) I $L($P(^LR(LRDFN,LRSS,LRIDT,0),U,9)),$E($P(^(0),U,9))'="-" S $P(^(0),U,9)="-"_$P(^(0),U,9) "RTN","ISIIMPL8",262,0) Q "RTN","ISIIMPL8",263,0) ; "RTN","ISIIMPL8",264,0) ; "RTN","ISIIMPL8",265,0) PG Q:$Y<(IOSL+5) "RTN","ISIIMPL8",266,0) I $E(IOST,1,2)'="C-" Q ;W @IOF Q "RTN","ISIIMPL8",267,0) D PG^LRGVP "RTN","ISIIMPL8",268,0) Q "RTN","ISIIMPL8",269,0) ; "RTN","ISIIMPL8",270,0) V21 ; "RTN","ISIIMPL8",271,0) N Y,LREND "RTN","ISIIMPL8",272,0) S LRSB=1,LRLCT=1 "RTN","ISIIMPL8",273,0) F S LRSB=+$O(LRSB(LRSB)) Q:'LRSB!($G(LREND)) D "RTN","ISIIMPL8",274,0) . N LRX "RTN","ISIIMPL8",275,0) . S LRTS=$O(^LAB(60,"C","CH;"_LRSB_";1",0)) Q:'LRTS "RTN","ISIIMPL8",276,0) . D V25^ISIIMPL9 ;D V25^LRVER5 "RTN","ISIIMPL8",277,0) . S X1="" ;W !,$P(^LAB(60,LRTS,0),U) S X1="" "RTN","ISIIMPL8",278,0) . I $D(^LR(LRDFN,LRSS,+LRLDT,LRSB)) D "RTN","ISIIMPL8",279,0) . . S X1=$P(^(LRSB),U),(LRDL,X)=X1 "RTN","ISIIMPL8",280,0) . . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","ISIIMPL8",281,0) . . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",X1) "RTN","ISIIMPL8",282,0) . . . I X="" S X=X1 "RTN","ISIIMPL8",283,0) . . ;W:X'="" ?30,@LRFP "RTN","ISIIMPL8",284,0) . S (LRDL,LRX,X)=$P(LRSB(LRSB),U) "RTN","ISIIMPL8",285,0) . S LREDIT=0,LRFLG=$P(LRSB(LRSB),U,2) "RTN","ISIIMPL8",286,0) . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D "RTN","ISIIMPL8",287,0) . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",LRX) "RTN","ISIIMPL8",288,0) . . I X="" S X=LRX "RTN","ISIIMPL8",289,0) . ;W ?44," ",@LRFP," ",LRFLG,?56," ",$P(LRNG,U,7) "RTN","ISIIMPL8",290,0) . S X=LRX "RTN","ISIIMPL8",291,0) . I X=""!(X="canc")!(X="comment")!(X="pending") Q "RTN","ISIIMPL8",292,0) . S Y=0 "RTN","ISIIMPL8",293,0) . I LRDEL'="" S LRQ=1 X LRDEL K LRQ "RTN","ISIIMPL8",294,0) . ;W " " "RTN","ISIIMPL8",295,0) . I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG "RTN","ISIIMPL8",296,0) . I '$D(LRNUF) S LRLCT=LRLCT+1 S:$X>80 LRLCT=LRLCT+1 D:LRLCT>15 WT S:$E($G(Y))="^" LREND=1 "RTN","ISIIMPL8",297,0) Q "RTN","ISIIMPL9") 0^48^B80411385 "RTN","ISIIMPL9",1,0) ISIIMPL9 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL9",2,0) ;;1.0;;;JUN 26,2012;Build 30 "RTN","ISIIMPL9",3,0) ; "RTN","ISIIMPL9",4,0) LRZVER5 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ;12/7/06 09:14 "RTN","ISIIMPL9",5,0) ;;5.2;LAB SERVICE;**42,153,283,286**;Sep 27, 1994 "RTN","ISIIMPL9",6,0) ; "RTN","ISIIMPL9",7,0) I $G(LRNDISP) D "RTN","ISIIMPL9",8,0) . S LRNX=0 "RTN","ISIIMPL9",9,0) . N LRX F S LRNX=$O(LRORD(LRNX)) Q:LRNX<1 S LRX(LRORD(LRNX))="" "RTN","ISIIMPL9",10,0) . S LRX=0 F S LRX=$O(LRSB(LRX)) Q:LRX<1 K:'$D(LRX(LRX)) LRSB(LRX),LRSA(LRX) "RTN","ISIIMPL9",11,0) ; "RTN","ISIIMPL9",12,0) ; Check for amended results that have arrived via an HL7 interface. "RTN","ISIIMPL9",13,0) ; Only allow amended results to be verified during this session. "RTN","ISIIMPL9",14,0) I $D(^LAH("LA7 AMENDED RESULTS",LRUID)) D "RTN","ISIIMPL9",15,0) . S LRNX=0 "RTN","ISIIMPL9",16,0) . F S LRNX=$O(LRORD(LRNX)) Q:'LRNX I '$D(^LAH("LA7 AMENDED RESULTS",LRUID,LRORD(LRNX))) K LRORD(LRNX) "RTN","ISIIMPL9",17,0) . S LRNX=0 "RTN","ISIIMPL9",18,0) . F S LRNX=$O(LRSB(LRNX)) Q:'LRNX I '$D(^LAH("LA7 AMENDED RESULTS",LRUID,LRNX)) K LRSB(LRNX),LRSA(LRNX) "RTN","ISIIMPL9",19,0) ; "RTN","ISIIMPL9",20,0) S LRNX=0,LRVRM=12 "RTN","ISIIMPL9",21,0) ; "RTN","ISIIMPL9",22,0) V40 S LRNX=$O(LRORD(LRNX)) G V44:LRNX<1 D LRSUBS "RTN","ISIIMPL9",23,0) ; "RTN","ISIIMPL9",24,0) ; Check if changing performing lab. "RTN","ISIIMPL9",25,0) I $P($G(LRSB(LRSB)),"^",9),'$$PLOK^LRVERA($P(LRSB(LRSB),"^",9),$G(LRDUZ(2)),DUZ(2),LRTS) G V40 "RTN","ISIIMPL9",26,0) ; "RTN","ISIIMPL9",27,0) D V25 "RTN","ISIIMPL9",28,0) ; "RTN","ISIIMPL9",29,0) V42 ; "RTN","ISIIMPL9",30,0) ; "RTN","ISIIMPL9",31,0) S (LRDL,SX,X)=$P($G(LRSB(LRSB)),U),LRDVF=0,LREDIT=0 "RTN","ISIIMPL9",32,0) S:X=""&(LRDV'="") X=LRDV,LRDVF=1 ; default value "RTN","ISIIMPL9",33,0) S LRTEST=$P(^LAB(60,LRTS,0),U) "RTN","ISIIMPL9",34,0) K LRNOVER(LRSB) "RTN","ISIIMPL9",35,0) ; "RTN","ISIIMPL9",36,0) Q42 ; "RTN","ISIIMPL9",37,0) ; "RTN","ISIIMPL9",38,0) ; Check for amended results that have arrived via an HL7 interface. "RTN","ISIIMPL9",39,0) I $D(^LAH("LA7 AMENDED RESULTS",LRUID,LRSB)) D G:SX'=X!($G(LRAMEND(LRSB))) V45 "RTN","ISIIMPL9",40,0) . ;W !,LRTEST," " W:X'="" @LRFP "RTN","ISIIMPL9",41,0) . D AMEND Q:$G(LRAMEND(LRSB)) "RTN","ISIIMPL9",42,0) . I SX=X ;W !,LRTEST," " W:X'="" @LRFP "RTN","ISIIMPL9",43,0) ; "RTN","ISIIMPL9",44,0) ; If entering results from a reference lab and not using normal/units "RTN","ISIIMPL9",45,0) ; from file #60 then ask user for these values otherwise display "RTN","ISIIMPL9",46,0) ; current file #60 values. "RTN","ISIIMPL9",47,0) I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2) D "RTN","ISIIMPL9",48,0) . I $G(^LAB(60,+LRTS,1,+$G(LRSPEC),.1)) D Q "RTN","ISIIMPL9",49,0) . . D V25 "RTN","ISIIMPL9",50,0) . . ;W !!,"Current Ref Range: ",LRNG2,"-",LRNG3," Units: ",$P(LRNG,"^",7) "RTN","ISIIMPL9",51,0) . . I LRNG4="",LRNG5="" Q "RTN","ISIIMPL9",52,0) . . ;W !," Critical Low: ",LRNG4," Critical High: ",LRNG5 "RTN","ISIIMPL9",53,0) . N LRX,LRY "RTN","ISIIMPL9",54,0) . D ASKPLNR,NORM "RTN","ISIIMPL9",55,0) . S LRX=$P(LRNGS,"^",2,5),LRX=$TR(LRX,"^","!") "RTN","ISIIMPL9",56,0) . S LRY=$P($G(LRSB(LRSB)),"^",5),$P(LRY,"!",2,5)=LRX "RTN","ISIIMPL9",57,0) . S $P(LRSB(LRSB),"^",5)=LRY "RTN","ISIIMPL9",58,0) ; "RTN","ISIIMPL9",59,0) I '$G(LRZONE) ;W !,LRTEST," " W:X'="" @LRFP "RTN","ISIIMPL9",60,0) I $D(^TMP("LRVEHU",$J,"R")) S X=^("R") ;; JFR - added "RTN","ISIIMPL9",61,0) ;I '$D(^TMP("LRVEHU",$J,"R")) R "//",X:DTIME ;; JFR - added "RTN","ISIIMPL9",62,0) I '$D(X) S X="^" ; JFR added to control runaway "RTN","ISIIMPL9",63,0) I X'?.ANP G V42 ;W $C(7)," No Control Characters allowed." G V42 "RTN","ISIIMPL9",64,0) S:$L($G(SX))&(X="") X=SX,LRDVF=1 "RTN","ISIIMPL9",65,0) S LRDL=X I X=""&LRDVF S (LRD,X)=LRDV G V45 "RTN","ISIIMPL9",66,0) Q43 G V40:X="",V45:X'["^",V44:X="^",LROUT:X="^^" "RTN","ISIIMPL9",67,0) ; "RTN","ISIIMPL9",68,0) V43 S X=$P(X,U,2),DIC="^LAB(60,",DIC(0)="EOQZ" D ^DIC G:Y<1 Q42 "RTN","ISIIMPL9",69,0) S LRPLOC=$P(Y(0),U,5),LRSSQ=$P(LRPLOC,";",1),LRSB=$P(LRPLOC,";",2),LRTS=+Y "RTN","ISIIMPL9",70,0) I LRSSQ="" G LROUT ;W !,"Not in this group" G LROUT "RTN","ISIIMPL9",71,0) I LRSS'=LRSSQ!'$D(^TMP("LR",$J,"TMP",LRSB)) G LROUT ;W !,"Not in this group" G LROUT "RTN","ISIIMPL9",72,0) S LRNX=0 "RTN","ISIIMPL9",73,0) F S LRNX=$O(LRORD(LRNX)) Q:LRNX<1 Q:LRSB=LRORD(LRNX) "RTN","ISIIMPL9",74,0) I LRNX,LRSB=LRORD(LRNX) D LRSUBS,V25 G V42 "RTN","ISIIMPL9",75,0) ; "RTN","ISIIMPL9",76,0) V44 K SX "RTN","ISIIMPL9",77,0) ; D COM^LRVER4 ;;; JFR - commented to stop comment prompt "RTN","ISIIMPL9",78,0) S LRNUF=1 S:LRVF LRSA=1 "RTN","ISIIMPL9",79,0) Q "RTN","ISIIMPL9",80,0) ; "RTN","ISIIMPL9",81,0) V45 ; "RTN","ISIIMPL9",82,0) K LRSKIP "RTN","ISIIMPL9",83,0) I X="@" D G V46 "RTN","ISIIMPL9",84,0) . K:'$G(LRVF) ^LR(LRDFN,LRSS,LRIDT,LRSB) "RTN","ISIIMPL9",85,0) . S X=$S($G(LRVF)&($D(LRSB(LRSB)))&('$D(LRM(LRSB))):"comment",$D(LRM(LRSB)):"pending",$D(LRSA(LRSB)):"canc",1:"") "RTN","ISIIMPL9",86,0) . S $P(LRSB(LRSB),"^")=X,$P(LRSB(LRSB),"^",2)="" "RTN","ISIIMPL9",87,0) ; "RTN","ISIIMPL9",88,0) S LRXD=U_$P(^LAB(60,LRTS,0),U,12),LRXDP=LRXD_"0)",LRXDP=@LRXDP "RTN","ISIIMPL9",89,0) X:'(X="*"!($E(X)="?")!(X="C")!(X="#")!(X="canc")!(X="pending")) $P(LRXDP,U,5,99) "RTN","ISIIMPL9",90,0) I '$D(X)#2 D HELP G V42 "RTN","ISIIMPL9",91,0) I $D(X)#2,X["?" D HELP G:'($P(LRXDP,U,2)["S") V42 "RTN","ISIIMPL9",92,0) I $D(X)#2,$P(LRXDP,U,2)["S",X'="*",X'="#",X'="canc",X'="pending" D LRSET G:'$D(X)#2 V42 "RTN","ISIIMPL9",93,0) I $D(X)#2,X="C",$P(LRXDP,U,2)'["S" D COMP G V42 "RTN","ISIIMPL9",94,0) ; "RTN","ISIIMPL9",95,0) V46 ; "RTN","ISIIMPL9",96,0) G V42:'$D(X)#2 "RTN","ISIIMPL9",97,0) I LRVF,$D(LRSB(LRSB)),$D(LRSA(LRSB)) S LRSA(LRSB,1)=LRTEST "RTN","ISIIMPL9",98,0) S X1=$S($D(^LR(LRDFN,LRSS,+LRLDT,LRSB)):$P(^(LRSB),U),1:"") "RTN","ISIIMPL9",99,0) S:X="*" X="canc" S:X="#" X="comment" "RTN","ISIIMPL9",100,0) ; "RTN","ISIIMPL9",101,0) I '$G(LRAMEND(LRSB)) S LRFLG="" "RTN","ISIIMPL9",102,0) S Y=0 X:LRDEL'="" LRDEL "RTN","ISIIMPL9",103,0) I '$G(LRAMEND(LRSB)) D RANGE^ISIIMPL8 ;D RANGE^LRZVER4 "RTN","ISIIMPL9",104,0) ; "RTN","ISIIMPL9",105,0) S:$P(X,U)="" $P(LRSB(LRSB),U)="" "RTN","ISIIMPL9",106,0) I $P(X,U)'="" D "RTN","ISIIMPL9",107,0) . S $P(LRSB(LRSB),U)=X,$P(LRSB(LRSB),U,2)=LRFLG "RTN","ISIIMPL9",108,0) . S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3) "RTN","ISIIMPL9",109,0) . F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I) "RTN","ISIIMPL9",110,0) . S $P(LRSB(LRSB),U,3)=LRY "RTN","ISIIMPL9",111,0) . I $P($P(LRSB(LRSB),U,3),"!")="" D RONLT^LRVER3 "RTN","ISIIMPL9",112,0) . D "RTN","ISIIMPL9",113,0) . . I '$D(LRSA(LRSB))#2 D Q "RTN","ISIIMPL9",114,0) . . . S $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","ISIIMPL9",115,0) . . . S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),1:$G(DUZ(2))) "RTN","ISIIMPL9",116,0) . . S:'$P(LRSB(LRSB),U,4) $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)) "RTN","ISIIMPL9",117,0) . S $P(LRSB(LRSB),U,5)=$TR(LRNGS,U,"!") "RTN","ISIIMPL9",118,0) . S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),1:$G(DUZ(2))) "RTN","ISIIMPL9",119,0) G:$D(LRNUF) V44 K LRNUF G V40:'$D(LRSKIP) S X=LRSKIP G Q43:X["^",V40 "RTN","ISIIMPL9",120,0) ; "RTN","ISIIMPL9",121,0) ; "RTN","ISIIMPL9",122,0) RANGE ; "RTN","ISIIMPL9",123,0) S $P(LRSB(LRSB),"^")=X "RTN","ISIIMPL9",124,0) ; If previous results from another laboratory then use normals and units "RTN","ISIIMPL9",125,0) ; associated with those results. "RTN","ISIIMPL9",126,0) D "RTN","ISIIMPL9",127,0) . I $G(LRDUZ(2)),DUZ(2)'=LRDUZ(2) D PLNR^LRVR4 Q "RTN","ISIIMPL9",128,0) . I $P(LRSB(LRSB),"^",9),DUZ(2)'=$P(LRSB(LRSB),"^",9) D PLNR^LRVR4 "RTN","ISIIMPL9",129,0) D RANGE^ISIIMPL8 ;D RANGE^LRZVER4 "RTN","ISIIMPL9",130,0) Q "RTN","ISIIMPL9",131,0) ; "RTN","ISIIMPL9",132,0) ; "RTN","ISIIMPL9",133,0) LRSUBS ; From LRVR5 "RTN","ISIIMPL9",134,0) S LRSB=LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB))#2:^(LRSB),1:0) "RTN","ISIIMPL9",135,0) Q "RTN","ISIIMPL9",136,0) ; "RTN","ISIIMPL9",137,0) ; "RTN","ISIIMPL9",138,0) LRSET ; from above and LRVR5 "RTN","ISIIMPL9",139,0) ; "RTN","ISIIMPL9",140,0) N I,LRERR,RESULT "RTN","ISIIMPL9",141,0) D CHK^DIE(63.04,LRSB,"EH",X,.RESULT,"LRERR") "RTN","ISIIMPL9",142,0) ; "RTN","ISIIMPL9",143,0) I RESULT'="^" S X=RESULT ;W " ",RESULT(0) "RTN","ISIIMPL9",144,0) ; "RTN","ISIIMPL9",145,0) I RESULT="^" D "RTN","ISIIMPL9",146,0) . F I=1:1:LRERR("DIHELP") ;W !,LRERR("DIHELP",I) "RTN","ISIIMPL9",147,0) . K X "RTN","ISIIMPL9",148,0) ; "RTN","ISIIMPL9",149,0) Q "RTN","ISIIMPL9",150,0) ; "RTN","ISIIMPL9",151,0) ; "RTN","ISIIMPL9",152,0) COMP ; from LRVR5 "RTN","ISIIMPL9",153,0) S X="^%ET",@^%ZOSF("TRAP") "RTN","ISIIMPL9",154,0) R !,"Enter your computation: ",C:DTIME "RTN","ISIIMPL9",155,0) Q:"^"[C G CH:C="?"!(C["""") S C=$P(C," ",1) "RTN","ISIIMPL9",156,0) S X="TRAP^LRVER5",@^%ZOSF("TRAP") D ^DIM S X="W "_C "RTN","ISIIMPL9",157,0) I '$D(X)#2 G CH ;W !,"Something's wrong with the syntax." G CH "RTN","ISIIMPL9",158,0) F I=1:1:$L(C) I $E(C,I)?1A S I=.9 Q "RTN","ISIIMPL9",159,0) G CH:I=.9,CH:C["/0",CH:C["\0" G COMP ;W !," equals ",@C G COMP "RTN","ISIIMPL9",160,0) TRAP ; "RTN","ISIIMPL9",161,0) ;W !!,"Error in your mathematical formular ",! "RTN","ISIIMPL9",162,0) CH ;W !,"Enter for example: 5*2/4+1 and 3.5 will be returned [i.e. ((5*2)/4)+1=3.5]" "RTN","ISIIMPL9",163,0) G COMP "RTN","ISIIMPL9",164,0) ; "RTN","ISIIMPL9",165,0) ; "RTN","ISIIMPL9",166,0) V25 ; From LRVER4 "RTN","ISIIMPL9",167,0) N LRTX,LRX "RTN","ISIIMPL9",168,0) S (LRDV,LRNG,LRDEL,LRNGS)="" "RTN","ISIIMPL9",169,0) I '$D(^LAB(60,+LRTS,0))#2 Q "RTN","ISIIMPL9",170,0) S LRX=+$P($P(^LAB(60,+LRTS,0),U,5),";",2) "RTN","ISIIMPL9",171,0) S LRTX=$S($L($P(^LAB(60,+LRTS,0),U,5)):$O(^LAB(60,"C",$P(^LAB(60,+LRTS,0),U,5),0)),1:+LRTS) "RTN","ISIIMPL9",172,0) S LRFP=$P(^LAB(60,LRTX,.1),U,3) "RTN","ISIIMPL9",173,0) I LRFP="" S LRFP="$J(X,8)" "RTN","ISIIMPL9",174,0) ; "RTN","ISIIMPL9",175,0) ; Normal ranges, units, delta checks and default value "RTN","ISIIMPL9",176,0) I $D(^LAB(60,LRTX,1,+$G(LRSPEC),0)) D "RTN","ISIIMPL9",177,0) . S LRNG=^LAB(60,LRTX,1,+$G(LRSPEC),0) "RTN","ISIIMPL9",178,0) . S LRDEL=$G(^LAB(62.1,+$P(LRNG,U,8),1)) "RTN","ISIIMPL9",179,0) . S LRDEL(1)=$G(^LAB(62.1,+$P(LRNG,U,8),2),"Q") "RTN","ISIIMPL9",180,0) . S X2=$P(LRNG,U,9) "RTN","ISIIMPL9",181,0) . S LRDV=$S('$D(LRSB(LRX)):$P(LRNG,U,10),1:"") "RTN","ISIIMPL9",182,0) ; "RTN","ISIIMPL9",183,0) ; When entering results from a reference lab check if flag to use normals/units from file 60. "RTN","ISIIMPL9",184,0) I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2),'$G(^LAB(60,LRTX,1,+$G(LRSPEC),.1)) D PLNR^LRVR4 "RTN","ISIIMPL9",185,0) ; "RTN","ISIIMPL9",186,0) NORM ; "RTN","ISIIMPL9",187,0) I $G(SEX)="" S SEX="M" "RTN","ISIIMPL9",188,0) I $G(AGE)="" S AGE=99 "RTN","ISIIMPL9",189,0) S LRNGS=LRNG "RTN","ISIIMPL9",190,0) F LRX=2:1:5 D "RTN","ISIIMPL9",191,0) . N LRY "RTN","ISIIMPL9",192,0) . S LRY=$P(LRNG,"^",LRX) "RTN","ISIIMPL9",193,0) . ; enclose in quotes if text or structured numeric "RTN","ISIIMPL9",194,0) . I LRY'="",$E(LRY)?.(1A,1"<",1">") S LRY=$C(34)_LRY_$C(34) "RTN","ISIIMPL9",195,0) . I LRY'="",$E(LRY)'=$C(34),LRY'?.N.1".".N S @("LRY"_"="_LRY) "RTN","ISIIMPL9",196,0) . S $P(LRNG,"^",LRX)=LRY,$P(LRNGS,"^",LRX)=LRY,@("LRNG"_LRX)=LRY "RTN","ISIIMPL9",197,0) Q "RTN","ISIIMPL9",198,0) ; "RTN","ISIIMPL9",199,0) ; "RTN","ISIIMPL9",200,0) LROUT ; "RTN","ISIIMPL9",201,0) K SX "RTN","ISIIMPL9",202,0) S LROUT=1 "RTN","ISIIMPL9",203,0) Q "RTN","ISIIMPL9",204,0) ; "RTN","ISIIMPL9",205,0) ; "RTN","ISIIMPL9",206,0) HELP S LRXDH=LRXD_"3)" "RTN","ISIIMPL9",207,0) ;W:$D(@LRXDH) " ",@LRXDH "RTN","ISIIMPL9",208,0) ;W !,"Enter * to report ""canc"" for canceled." "RTN","ISIIMPL9",209,0) ;W !,"Enter # to report ""comment""." "RTN","ISIIMPL9",210,0) ;W:'($P(LRXDP,U,2)["S") !,"Enter C to enter calculate mode." "RTN","ISIIMPL9",211,0) Q "RTN","ISIIMPL9",212,0) ; "RTN","ISIIMPL9",213,0) ; "RTN","ISIIMPL9",214,0) AMEND ; Process amended results and prompt user "RTN","ISIIMPL9",215,0) N LRANS,LRLL,LRSQ,LRROOT,LRX "RTN","ISIIMPL9",216,0) ; flag to indicate if amended results have been extracted from LAH "RTN","ISIIMPL9",217,0) S LRAMEND=0 "RTN","ISIIMPL9",218,0) ; save current value of X "RTN","ISIIMPL9",219,0) S LRX=X "RTN","ISIIMPL9",220,0) S LRROOT=$Q(^LAH("LA7 AMENDED RESULTS",LRUID,LRSB)) "RTN","ISIIMPL9",221,0) I LRROOT="" Q "RTN","ISIIMPL9",222,0) I $QS(LRROOT,1)'="LA7 AMENDED RESULTS"!($QS(LRROOT,2)'=LRUID)!($QS(LRROOT,3)'=LRSB) Q "RTN","ISIIMPL9",223,0) S LRLL=$QS(LRROOT,4),LRSQ=$QS(LRROOT,5) "RTN","ISIIMPL9",224,0) I $D(^LAH(LRLL,1,LRSQ,LRSB)) D "RTN","ISIIMPL9",225,0) . N DIR,DIRUT,DTOUT,DUOUT,LRJ,LRY,X,Y "RTN","ISIIMPL9",226,0) . S LRY=^LAH(LRLL,1,LRSQ,LRSB) "RTN","ISIIMPL9",227,0) . S DIR(0)="SOA^0:No;1:Yes;2:Keep but do not process",DIR("B")="Yes" "RTN","ISIIMPL9",228,0) . S DIR("A",1)=" ",DIR("A",2)="Amended result: "_$P(LRY,"^") "RTN","ISIIMPL9",229,0) . S DIR("A",2)=DIR("A",2)_" flag: "_$S($P(LRY,"^",2)'="":$P(LRY,"^",2),1:"None") "RTN","ISIIMPL9",230,0) . S DIR("A",2)=DIR("A",2)_" units: "_$P($P(LRY,"^",5),"!",7) "RTN","ISIIMPL9",231,0) . S DIR("A")="Accept amended results: " "RTN","ISIIMPL9",232,0) . S DIR("?",1)="Answer with 0-No to not accept amended result and delete.",DIR("?",2)="1-Yes to process amended result.",DIR("?")="or 2-Keep which skips processing but leaves result for future processing." "RTN","ISIIMPL9",233,0) . D ^DIR "RTN","ISIIMPL9",234,0) . I $D(DIRUT) Q "RTN","ISIIMPL9",235,0) . S LRANS=Y "RTN","ISIIMPL9",236,0) . I LRANS=2 Q "RTN","ISIIMPL9",237,0) . I LRANS=1 D "RTN","ISIIMPL9",238,0) . . S LRX=$P(LRY,"^"),LRFLG=$P(LRY,"^",2),LRSB(LRSB)=LRY,LRJ=$P(LRY,"^",5) "RTN","ISIIMPL9",239,0) . . F LRI=1,2,3,4,5,7,11,12 S $P(LRNG,"^",LRI)=$P(LRJ,"!",LRI) "RTN","ISIIMPL9",240,0) . . S LRNGS=LRNG,(LRAMEND,LRAMEND(LRSB))=1 "RTN","ISIIMPL9",241,0) . . D LRSBCOM^LRVR4 ; also process any comments "RTN","ISIIMPL9",242,0) . K ^LAH(LRLL,1,LRSQ,LRSB) "RTN","ISIIMPL9",243,0) . K ^LAH("LA7 AMENDED RESULTS",LRUID,LRSB,LRLL,LRSQ) "RTN","ISIIMPL9",244,0) . I +$O(^LAH(LRLL,1,LRSQ,1))<1 D ZAPALL^LRVR3(LRLL,LRSQ) "RTN","ISIIMPL9",245,0) S X=LRX "RTN","ISIIMPL9",246,0) Q "RTN","ISIIMPL9",247,0) ; "RTN","ISIIMPL9",248,0) ; "RTN","ISIIMPL9",249,0) ASKPLNR ; Ask user for performing lab normal ranges and units when entering "RTN","ISIIMPL9",250,0) ; manually and not using values from file #60. "RTN","ISIIMPL9",251,0) N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRI,LRJ,LRX,LRY,Y,X,Y "RTN","ISIIMPL9",252,0) ; "RTN","ISIIMPL9",253,0) S LRX=$P($G(LRSB(LRSB)),"^",5) "RTN","ISIIMPL9",254,0) ; "RTN","ISIIMPL9",255,0) ;W !!,"For test ",LRTEST "RTN","ISIIMPL9",256,0) S DIR(0)="60.01,6" "RTN","ISIIMPL9",257,0) I $P(LRX,"!",7)'="" S DIR("B")=$P(LRX,"!",7) "RTN","ISIIMPL9",258,0) D ^DIR "RTN","ISIIMPL9",259,0) I $D(DTOUT)!($D(DUOUT)) Q "RTN","ISIIMPL9",260,0) ; Set units into component 7 of piece 5 "RTN","ISIIMPL9",261,0) S $P(LRX,"!",7)=Y,$P(LRSB(LRSB),"^",5)=LRX "RTN","ISIIMPL9",262,0) ; "RTN","ISIIMPL9",263,0) ; Ask normals - high/low and critical "RTN","ISIIMPL9",264,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","ISIIMPL9",265,0) F LRJ=1,2,3,4 D Q:$D(DTOUT)!($D(DUOUT)) "RTN","ISIIMPL9",266,0) . K DIR "RTN","ISIIMPL9",267,0) . S DIR(0)="60.01,"_LRJ,LRI=LRJ+1 "RTN","ISIIMPL9",268,0) . I $P(LRX,"!",LRI)'="" D "RTN","ISIIMPL9",269,0) . . S DIR("B")=$P(LRX,"!",LRI) "RTN","ISIIMPL9",270,0) . . I $E(DIR("B"))=$C(34) Q "RTN","ISIIMPL9",271,0) . . I DIR("B")'?.N.1".".N S DIR("B")=$C(34)_DIR("B")_$C(34) ; enclose in quotes if text "RTN","ISIIMPL9",272,0) . D ^DIR "RTN","ISIIMPL9",273,0) . I $D(DTOUT)!($D(DUOUT)) Q "RTN","ISIIMPL9",274,0) . S $P(LRX,"!",LRI)=Y "RTN","ISIIMPL9",275,0) ; "RTN","ISIIMPL9",276,0) ; Ask user for normality in case user does not know high/low/critical. "RTN","ISIIMPL9",277,0) S LRRFLAG(LRSB)=$$RFLAG^LRVERA($P($G(LRSB(LRSB)),"^",2)) "RTN","ISIIMPL9",278,0) ; "RTN","ISIIMPL9",279,0) ; Update normal variable LRNG "RTN","ISIIMPL9",280,0) I $P(LRX,"!")="" S $P(LRX,"!")=LRSPEC "RTN","ISIIMPL9",281,0) F LRI=1,2,3,4,5,7 S $P(LRNG,"^",LRI)=$P(LRX,"!",LRI) "RTN","ISIIMPL9",282,0) ; "RTN","ISIIMPL9",283,0) Q "RTN","ISIIMPR1") 0^6^B3704 "RTN","ISIIMPR1",1,0) ISIIMPR1 ;ISI GROUP/MLS -- Import RPC "RTN","ISIIMPR1",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPR1",3,0) Q "RTN","ISIIMPR1",4,0) PNTIMPRT(ISIRESUL,MISC) "RTN","ISIIMPR1",5,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR1",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR1",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR1",8,0) ; "RTN","ISIIMPR1",9,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR1",10,0) . ;Write out input parameters "RTN","ISIIMPR1",11,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR1",12,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR1",13,0) . W !,"" R X:5 "RTN","ISIIMPR1",14,0) . Q "RTN","ISIIMPR1",15,0) ; "RTN","ISIIMPR1",16,0) D "RTN","ISIIMPR1",17,0) . S ISIRC=$$PNTMISC^ISIIMPU1(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR1",18,0) . K MISC "RTN","ISIIMPR1",19,0) . S ISIRC=$$PATIENT^ISIIMP02(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR1",20,0) . Q "RTN","ISIIMPR1",21,0) ; "RTN","ISIIMPR1",22,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" "RTN","ISIIMPR1",23,0) Q "RTN","ISIIMPR1",24,0) ; "RTN","ISIIMPR1",25,0) APPMAKE(ISIRESUL,MISC) "RTN","ISIIMPR1",26,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR1",27,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR1",28,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR1",29,0) ; "RTN","ISIIMPR1",30,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR1",31,0) . ;Write out input parameters "RTN","ISIIMPR1",32,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR1",33,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR1",34,0) . W !,"" R X:5 "RTN","ISIIMPR1",35,0) . Q "RTN","ISIIMPR1",36,0) ; "RTN","ISIIMPR1",37,0) D "RTN","ISIIMPR1",38,0) . S ISIRC=$$APPTMISC^ISIIMPU2(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR1",39,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR1",40,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR1",41,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR1",42,0) . . W !,"" R X:5 "RTN","ISIIMPR1",43,0) . . Q "RTN","ISIIMPR1",44,0) . K MISC "RTN","ISIIMPR1",45,0) . S ISIRC=$$APPOINT^ISIIMP04 "RTN","ISIIMPR1",46,0) . Q "RTN","ISIIMPR1",47,0) ; "RTN","ISIIMPR1",48,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" "RTN","ISIIMPR1",49,0) Q "RTN","ISIIMPR1",50,0) ; "RTN","ISIIMPR1",51,0) PROBMAKE(ISIRESUL,MISC) "RTN","ISIIMPR1",52,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR1",53,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR1",54,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR1",55,0) ; "RTN","ISIIMPR1",56,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR1",57,0) . ;Write out input parameters "RTN","ISIIMPR1",58,0) . W !,"+++Raw input params (PR1)+++",! "RTN","ISIIMPR1",59,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR1",60,0) . W !,"" R X:5 "RTN","ISIIMPR1",61,0) . Q "RTN","ISIIMPR1",62,0) ; "RTN","ISIIMPR1",63,0) D "RTN","ISIIMPR1",64,0) . S ISIRC=$$PROBMISC^ISIIMPU4(.MISC,.ISIMISC) Q:+ISIRC<0 "RTN","ISIIMPR1",65,0) . K MISC "RTN","ISIIMPR1",66,0) . S ISIRC=$$PROBLEM^ISIIMP06(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR1",67,0) . Q "RTN","ISIIMPR1",68,0) ; "RTN","ISIIMPR1",69,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ; W !,"ERROR" "RTN","ISIIMPR1",70,0) Q "RTN","ISIIMPR1",71,0) ; "RTN","ISIIMPR1",72,0) VITMAKE(ISIRESUL,MISC) "RTN","ISIIMPR1",73,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR1",74,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR1",75,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR1",76,0) ; "RTN","ISIIMPR1",77,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR1",78,0) . ;Write out input parameters "RTN","ISIIMPR1",79,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR1",80,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR1",81,0) . W !,"" R X:5 "RTN","ISIIMPR1",82,0) . Q "RTN","ISIIMPR1",83,0) ; "RTN","ISIIMPR1",84,0) D "RTN","ISIIMPR1",85,0) . S ISIRC=$$VITMISC^ISIIMPU5(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR1",86,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR1",87,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR1",88,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR1",89,0) . . W !,"" R X:5 "RTN","ISIIMPR1",90,0) . . Q "RTN","ISIIMPR1",91,0) . K MISC "RTN","ISIIMPR1",92,0) . S ISIRC=$$VITALS^ISIIMP08(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR1",93,0) . Q "RTN","ISIIMPR1",94,0) ; "RTN","ISIIMPR1",95,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" "RTN","ISIIMPR1",96,0) Q "RTN","ISIIMPR1",97,0) ; "RTN","ISIIMPR1",98,0) RADOMAKE(ISIRESUL,MISC) "RTN","ISIIMPR1",99,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR1",100,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR1",101,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR1",102,0) ; "RTN","ISIIMPR1",103,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR1",104,0) . ;Write out input parameters "RTN","ISIIMPR1",105,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR1",106,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR1",107,0) . W !,"" R X:5 "RTN","ISIIMPR1",108,0) . Q "RTN","ISIIMPR1",109,0) ; "RTN","ISIIMPR1",110,0) D "RTN","ISIIMPR1",111,0) . S ISIRC=$$RADMISC^ISIIMPUC(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR1",112,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR1",113,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR1",114,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR1",115,0) . . W !,"" R X:5 "RTN","ISIIMPR1",116,0) . . Q "RTN","ISIIMPR1",117,0) . K MISC "RTN","ISIIMPR1",118,0) . S ISIRC=$$RADORDER^ISIIMP20(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR1",119,0) . Q "RTN","ISIIMPR1",120,0) ; "RTN","ISIIMPR1",121,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" "RTN","ISIIMPR1",122,0) Q "RTN","ISIIMPR2") 0^16^B3180 "RTN","ISIIMPR2",1,0) ISIIMPR2 ;ISI GROUP/MLS -- DATA LOADER RPC (2) "RTN","ISIIMPR2",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPR2",3,0) ; "RTN","ISIIMPR2",4,0) ALGMAKE(ISIRESUL,MISC) "RTN","ISIIMPR2",5,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",6,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR2",7,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR2",8,0) ; "RTN","ISIIMPR2",9,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR2",10,0) . ;Write out input parameters "RTN","ISIIMPR2",11,0) . W !,"+++Raw input parameters+++",! "RTN","ISIIMPR2",12,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR2",13,0) . W !,"" R X:5 "RTN","ISIIMPR2",14,0) . Q "RTN","ISIIMPR2",15,0) ; "RTN","ISIIMPR2",16,0) D "RTN","ISIIMPR2",17,0) . S ISIRC=$$ALGMISC^ISIIMPU6(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR2",18,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR2",19,0) . . W !,"++Read in values+++",! "RTN","ISIIMPR2",20,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR2",21,0) . . Q "RTN","ISIIMPR2",22,0) . K MISC "RTN","ISIIMPR2",23,0) . S ISIRC=$$ALLERGY^ISIIMP10(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR2",24,0) . Q "RTN","ISIIMPR2",25,0) ; "RTN","ISIIMPR2",26,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" Q "RTN","ISIIMPR2",27,0) Q "RTN","ISIIMPR2",28,0) ; "RTN","ISIIMPR2",29,0) LABMAKE(ISIRESUL,MISC) "RTN","ISIIMPR2",30,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",31,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR2",32,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR2",33,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR2",34,0) . ;Write out input parameters "RTN","ISIIMPR2",35,0) . W !,"+++Raw input parameters+++",! "RTN","ISIIMPR2",36,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR2",37,0) . W !,"" R X:5 "RTN","ISIIMPR2",38,0) . Q "RTN","ISIIMPR2",39,0) ; "RTN","ISIIMPR2",40,0) D "RTN","ISIIMPR2",41,0) . S ISIRC=$$LABMISC^ISIIMPU7(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR2",42,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR2",43,0) . . W !,"++Read in values+++",! "RTN","ISIIMPR2",44,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR2",45,0) . . Q "RTN","ISIIMPR2",46,0) . K MISC "RTN","ISIIMPR2",47,0) . S ISIRC=$$LAB^ISIIMP12(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR2",48,0) . Q "RTN","ISIIMPR2",49,0) ; "RTN","ISIIMPR2",50,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ; W !,"ERROR" Q "RTN","ISIIMPR2",51,0) Q "RTN","ISIIMPR2",52,0) ; "RTN","ISIIMPR2",53,0) NOTEMAKE(ISIRESUL,MISC) "RTN","ISIIMPR2",54,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",55,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR2",56,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR2",57,0) ; "RTN","ISIIMPR2",58,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR2",59,0) . ;Write out input parameters "RTN","ISIIMPR2",60,0) . W !,"+++Raw input parameters+++",! "RTN","ISIIMPR2",61,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR2",62,0) . W !,"" R X:5 "RTN","ISIIMPR2",63,0) . Q "RTN","ISIIMPR2",64,0) ; "RTN","ISIIMPR2",65,0) D "RTN","ISIIMPR2",66,0) . S ISIRC=$$NOTMISC^ISIIMPU8(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR2",67,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR2",68,0) . . W !,"++Read in values+++",! "RTN","ISIIMPR2",69,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR2",70,0) . . Q "RTN","ISIIMPR2",71,0) . K MISC "RTN","ISIIMPR2",72,0) . S ISIRC=$$NOTES^ISIIMP14(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR2",73,0) . Q "RTN","ISIIMPR2",74,0) ; "RTN","ISIIMPR2",75,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" Q "RTN","ISIIMPR2",76,0) Q "RTN","ISIIMPR2",77,0) ; "RTN","ISIIMPR2",78,0) MEDMAKE(ISIRESUL,MISC) "RTN","ISIIMPR2",79,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",80,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR2",81,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR2",82,0) ; "RTN","ISIIMPR2",83,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR2",84,0) . ;Write out input parameters "RTN","ISIIMPR2",85,0) . W !,"+++Raw input parameters+++",! "RTN","ISIIMPR2",86,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR2",87,0) . W !,"" R X:5 "RTN","ISIIMPR2",88,0) . Q "RTN","ISIIMPR2",89,0) ; "RTN","ISIIMPR2",90,0) D "RTN","ISIIMPR2",91,0) . S ISIRC=$$MEDMISC^ISIIMPU9(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR2",92,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR2",93,0) . . W !,"++Read in values+++",! "RTN","ISIIMPR2",94,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR2",95,0) . . Q "RTN","ISIIMPR2",96,0) . K MISC "RTN","ISIIMPR2",97,0) . S ISIRC=$$MEDS^ISIIMP16(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR2",98,0) . Q "RTN","ISIIMPR2",99,0) ; "RTN","ISIIMPR2",100,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" Q "RTN","ISIIMPR2",101,0) Q "RTN","ISIIMPR2",102,0) ; "RTN","ISIIMPR2",103,0) TABLEGET(ISIRESUL,TABLE) "RTN","ISIIMPR2",104,0) ; "RTN","ISIIMPR2",105,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",106,0) K ARRAY S ISIRESUL(0)=0 "RTN","ISIIMPR2",107,0) ; "RTN","ISIIMPR2",108,0) I $G(TABLE)="" S ISIRESUL(0)="-1^Incorrect parameter passed" Q "RTN","ISIIMPR2",109,0) S TABLE=$$PARAM^ISIIMPUA(TABLE) "RTN","ISIIMPR2",110,0) I TABLE=-1 S ISIRESUL(0)="-1^Incorrect parameter passed" Q "RTN","ISIIMPR2",111,0) ; "RTN","ISIIMPR2",112,0) D ENTRY^ISIIMPUA(.ISIRESUL,.TABLE) "RTN","ISIIMPR2",113,0) Q "RTN","ISIIMPR2",114,0) ; "RTN","ISIIMPR2",115,0) CONMAKE(ISIRESUL,MISC) "RTN","ISIIMPR2",116,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",117,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR2",118,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR2",119,0) ; "RTN","ISIIMPR2",120,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR2",121,0) . ;Write out input parameters "RTN","ISIIMPR2",122,0) . W !,"+++Raw input parameters+++",! "RTN","ISIIMPR2",123,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR2",124,0) . W !,"" R X:5 "RTN","ISIIMPR2",125,0) . Q "RTN","ISIIMPR2",126,0) ; "RTN","ISIIMPR2",127,0) D "RTN","ISIIMPR2",128,0) . S ISIRC=$$CONMISC^ISIIMPUB(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR2",129,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR2",130,0) . . W !,"++Read in values+++",! "RTN","ISIIMPR2",131,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR2",132,0) . . Q "RTN","ISIIMPR2",133,0) . K MISC "RTN","ISIIMPR2",134,0) . S ISIRC=$$CONSULTS^ISIIMP18(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR2",135,0) . Q "RTN","ISIIMPR2",136,0) ; "RTN","ISIIMPR2",137,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" Q "RTN","ISIIMPR2",138,0) Q "RTN","ISIIMPR2",139,0) ; "RTN","ISIIMPR2",140,0) ICD9GET(ISIRESUL,TXT) "RTN","ISIIMPR2",141,0) ; "RTN","ISIIMPR2",142,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",143,0) K ARRAY S ISIRESUL(0)=0 "RTN","ISIIMPR2",144,0) I $G(TXT)="" S ISIRESUL(0)="-1^Incorrect parameter passed" Q "RTN","ISIIMPR2",145,0) S TXT=$$UP^XLFSTR(TXT) "RTN","ISIIMPR2",146,0) D ICD9^ISIIMPUA(.ISIRESUL,.TXT) "RTN","ISIIMPR2",147,0) Q "RTN","ISIIMPU1") 0^8^B135487473 "RTN","ISIIMPU1",1,0) ISIIMPU1 ;ISI GROUP/MLS -- Patient Import Utility "RTN","ISIIMPU1",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPU1",3,0) Q "RTN","ISIIMPU1",4,0) ; "RTN","ISIIMPU1",5,0) ; Column definitions for MISCDEF table (below): "RTN","ISIIMPU1",6,0) ; NAME= name of parameter "RTN","ISIIMPU1",7,0) ; TYPE = categories of values provided "RTN","ISIIMPU1",8,0) ; 'PARAM' is internal used value "RTN","ISIIMPU1",9,0) ; 'FIELD' is a literal import value "RTN","ISIIMPU1",10,0) ; 'MASK' is dynamic value w/ * wildcard "RTN","ISIIMPU1",11,0) ; FIELD(#2)=the corresponding field in PATIENT(#2) file "RTN","ISIIMPU1",12,0) ; DESC = description of value "RTN","ISIIMPU1",13,0) ; "RTN","ISIIMPU1",14,0) ; Array example: "RTN","ISIIMPU1",15,0) ; MISC(1)="TEMPLATE|DEFAULT" "RTN","ISIIMPU1",16,0) ; MISC(2)="NAME_MASK|*,PATIENT" "RTN","ISIIMPU1",17,0) ; MISC(4)="SEX|F" "RTN","ISIIMPU1",18,0) ; MISC(5)="SSN_MASK|000*" "RTN","ISIIMPU1",19,0) ; "RTN","ISIIMPU1",20,0) MISCDEF ;;+++++ DEFINITIONS OF PATIENT MISC PARAMETERS +++++ "RTN","ISIIMPU1",21,0) ;;NAME |TYPE |FIELD(#2) |DESC "RTN","ISIIMPU1",22,0) ;;--------------------------------------------------------------- "RTN","ISIIMPU1",23,0) ;;TEMPLATE |PARAM | |Template Name "RTN","ISIIMPU1",24,0) ;;IMP_TYPE |PARAM | |'I'ndividual or 'B'atch "RTN","ISIIMPU1",25,0) ;;IMP_BATCH_NUM |PARAM | |Batch number to be imported "RTN","ISIIMPU1",26,0) ;;DFN_NAME |PARAM | |'Y' or 'N' for use of DFN derived NAME "RTN","ISIIMPU1",27,0) ;;TYPE |FIELD |391 |TYPE OF PATIENT value "RTN","ISIIMPU1",28,0) ;;NAME |FIELD |.01 |NAME value "RTN","ISIIMPU1",29,0) ;;NAME_MASK |MASK |.01 |Last name mask value "RTN","ISIIMPU1",30,0) ;;SEX |FIELD |.02 |SEX (M/F) value "RTN","ISIIMPU1",31,0) ;;DOB |FIELD |.03 |DOB value "RTN","ISIIMPU1",32,0) ;;RACE |FIELD |2.02,.01 |RACE INFORMATION value (pointer to #10) "RTN","ISIIMPU1",33,0) ;;ETHNICITY |FIELD |2.06,.01 |ETHNICITY INFORMATION value (pointer to #10.2) "RTN","ISIIMPU1",34,0) ;;LOW_DOB |PARAM |.03 |Lower date limit of auto DOB "RTN","ISIIMPU1",35,0) ;;UP_DOB |PARAM |.03 |Upper date limit of auto DOB "RTN","ISIIMPU1",36,0) ;;MARITAL_STATUS |FIELD |.05 |MARITAL STATUS value "RTN","ISIIMPU1",37,0) ;;OCCUPATION |FIELD |.07 |OCCUPATION (free text) "RTN","ISIIMPU1",38,0) ;;SSN |FIELD |.09 |SSN value "RTN","ISIIMPU1",39,0) ;;SSN_MASK |MASK |.09 |SSN mask value (5 digit max) "RTN","ISIIMPU1",40,0) ;;STREET_ADD1 |FIELD |.111 |Street ADD 1 value "RTN","ISIIMPU1",41,0) ;;STREET_ADD2 |FIELD |.112 |Street ADD 2 value "RTN","ISIIMPU1",42,0) ;;CITY |FIELD |.114 |CITY value "RTN","ISIIMPU1",43,0) ;;STATE |FIELD |.115 |STATE value "RTN","ISIIMPU1",44,0) ;;ZIP_4 |FIELD |.1112 |ZIP CODE value "RTN","ISIIMPU1",45,0) ;;ZIP_4_MASK |MASK |.1112 |Zip code mask value (5 max) "RTN","ISIIMPU1",46,0) ;;PH_NUM |FIELD |.131 |PHONE value "RTN","ISIIMPU1",47,0) ;;PH_NUM_MASK |MASK |.131 |Phone number mask value "RTN","ISIIMPU1",48,0) ;;EMPLOY_STAT |FIELD |.31115 |EMPLOYMENT STATUS value (table) "RTN","ISIIMPU1",49,0) ;;INSUR_TYPE |FIELD |2.312,.01 |INSURANCE TYPE (pointer to #36) "RTN","ISIIMPU1",50,0) ;;VETERAN |FIELD |1901 |VETERAN STATUS value "RTN","ISIIMPU1",51,0) Q "RTN","ISIIMPU1",52,0) ; "RTN","ISIIMPU1",53,0) PNTMISC(MISC,ISIMISC) "RTN","ISIIMPU1",54,0) ; "RTN","ISIIMPU1",55,0) ;INPUT: "RTN","ISIIMPU1",56,0) ; MISC - raw list values from RPC client "RTN","ISIIMPU1",57,0) ; "RTN","ISIIMPU1",58,0) ;OUTPUT: "RTN","ISIIMPU1",59,0) ; ISIMISC - indexed values for pnt create/import use "RTN","ISIIMPU1",60,0) ; "RTN","ISIIMPU1",61,0) N MISCDEF "RTN","ISIIMPU1",62,0) K ISIMISC "RTN","ISIIMPU1",63,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU1",64,0) S ISIRC=$$PNTMISC1("ISIMISC") "RTN","ISIIMPU1",65,0) Q ISIRC "RTN","ISIIMPU1",66,0) ; "RTN","ISIIMPU1",67,0) PNTMISC1(DSTNODE) "RTN","ISIIMPU1",68,0) N RETURN,ERRCNT,I,EXIT,PARAM,VALUE,TMPL,IENS,TYPE,FIELD,DATE,RESULT,MSG "RTN","ISIIMPU1",69,0) S (EXIT,TMPL,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPU1",70,0) F S I=$O(MISC(I)) Q:I="" D Q:EXIT "RTN","ISIIMPU1",71,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPU1",72,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPU1",73,0) . ; Process TEMPLATE first, then overlay with passed params "RTN","ISIIMPU1",74,0) . I PARAM="TEMPLATE" D "RTN","ISIIMPU1",75,0) . . I VALUE="" S ISIRC="-1^Invalid TEMPLATE name",EXIT=1 Q "RTN","ISIIMPU1",76,0) . . I '$D(^ISI(9001,"B",VALUE)) S ISIRC="-1^Invalid TEMPLATE name",EXIT=1 Q "RTN","ISIIMPU1",77,0) . . D TEMPLATE "RTN","ISIIMPU1",78,0) . . Q "RTN","ISIIMPU1",79,0) . I EXIT=1 Q "RTN","ISIIMPU1",80,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed",EXIT=1 Q "RTN","ISIIMPU1",81,0) . S TYPE=$P(MISCDEF(PARAM),"|"),FIELD=$P(MISCDEF(PARAM),"|",2) "RTN","ISIIMPU1",82,0) . I PARAM="TEMPLATE" Q ;already processed "RTN","ISIIMPU1",83,0) . I PARAM["DOB" D "RTN","ISIIMPU1",84,0) . . S DATE=VALUE D DT^DILF("",DATE,.RESULT,"",.MSG) "RTN","ISIIMPU1",85,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid date value in DOB, LO_DOB, or UP_DOB field" Q "RTN","ISIIMPU1",86,0) . . S VALUE=RESULT "RTN","ISIIMPU1",87,0) . I TYPE="FIELD" D "RTN","ISIIMPU1",88,0) . . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU1",89,0) . . Q "RTN","ISIIMPU1",90,0) . I TYPE="PARAM" D "RTN","ISIIMPU1",91,0) . . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU1",92,0) . . Q "RTN","ISIIMPU1",93,0) . I TYPE="MASK" D "RTN","ISIIMPU1",94,0) . . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU1",95,0) . . Q "RTN","ISIIMPU1",96,0) . Q "RTN","ISIIMPU1",97,0) Q ISIRC "RTN","ISIIMPU1",98,0) ; "RTN","ISIIMPU1",99,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPU1",100,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPU1",101,0) K MISCDEF "RTN","ISIIMPU1",102,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPU1",103,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPU1",104,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPU1",105,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPU1",106,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPU1",107,0) Q "RTN","ISIIMPU1",108,0) ; "RTN","ISIIMPU1",109,0) TEMPLATE "RTN","ISIIMPU1",110,0) N ARRAY,MSG "RTN","ISIIMPU1",111,0) S IENS=$O(^ISI(9001,"B",VALUE,""))_"," "RTN","ISIIMPU1",112,0) D GETS^DIQ(9001,IENS,"*","","ARRAY","MSG") "RTN","ISIIMPU1",113,0) I $G(DIERR) S ISIRC=-1,EXIT=1 Q "RTN","ISIIMPU1",114,0) S @DSTNODE@("TYPE")=ARRAY(9001,IENS,1) "RTN","ISIIMPU1",115,0) S @DSTNODE@("NAME_MASK")=ARRAY(9001,IENS,2) "RTN","ISIIMPU1",116,0) S @DSTNODE@("SSN_MASK")=ARRAY(9001,IENS,4) "RTN","ISIIMPU1",117,0) S @DSTNODE@("SEX")=ARRAY(9001,IENS,5) "RTN","ISIIMPU1",118,0) S @DSTNODE@("LOW_DOB")=ARRAY(9001,IENS,6) "RTN","ISIIMPU1",119,0) S @DSTNODE@("UP_DOB")=ARRAY(9001,IENS,7) "RTN","ISIIMPU1",120,0) S @DSTNODE@("MARITAL_STATUS")=ARRAY(9001,IENS,8) "RTN","ISIIMPU1",121,0) S @DSTNODE@("ZIP_4_MASK")=ARRAY(9001,IENS,9) "RTN","ISIIMPU1",122,0) S @DSTNODE@("PH_NUM_MASK")=ARRAY(9001,IENS,10) "RTN","ISIIMPU1",123,0) S @DSTNODE@("CITY")=ARRAY(9001,IENS,11) "RTN","ISIIMPU1",124,0) S @DSTNODE@("STATE")=ARRAY(9001,IENS,12) "RTN","ISIIMPU1",125,0) S @DSTNODE@("VETERAN")=ARRAY(9001,IENS,13) "RTN","ISIIMPU1",126,0) S @DSTNODE@("DFN_NAME")=ARRAY(9001,IENS,14) "RTN","ISIIMPU1",127,0) S @DSTNODE@("EMPLOY_STAT")=ARRAY(9001,IENS,15) "RTN","ISIIMPU1",128,0) Q "RTN","ISIIMPU1",129,0) ; "RTN","ISIIMPU1",130,0) VALIDATE(ISIMISC) "RTN","ISIIMPU1",131,0) ; Entry point to Validate content of patient create/array "RTN","ISIIMPU1",132,0) ; "RTN","ISIIMPU1",133,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMPU1",134,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMPU1",135,0) ; eg: ISIMISC("NAME")="FIRST,LAST" "RTN","ISIIMPU1",136,0) ; "RTN","ISIIMPU1",137,0) ; Output - ISIRC [return code] "RTN","ISIIMPU1",138,0) N FILE,FIELD,FLAG,VALUE,RESULT,MSG,MISCDEF,EXIT,Y "RTN","ISIIMPU1",139,0) S EXIT=0 "RTN","ISIIMPU1",140,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU1",141,0) ; "RTN","ISIIMPU1",142,0) ;-- IMP_TYPE -- "RTN","ISIIMPU1",143,0) I $G(ISIMISC("IMP_TYPE"))="" Q "-1^Missing IMP_TYPE" "RTN","ISIIMPU1",144,0) S ISIMISC("IMP_TYPE")=$TR(ISIMISC("IMP_TYPE"),"bi","BI") I $L(ISIMISC("IMP_TYPE"))'=1 Q "-1^Invalid IMP_TYPE" "RTN","ISIIMPU1",145,0) I ("BI"'[ISIMISC("IMP_TYPE")&(ISIMISC("IMP_TYPE")?1A)) Q "-1^Invalid IMP_TYPE" "RTN","ISIIMPU1",146,0) ; "RTN","ISIIMPU1",147,0) ;-- IMP_BATCH_NUM -- "RTN","ISIIMPU1",148,0) I (ISIMISC("IMP_TYPE")="B"&'($G(ISIMISC("IMP_BATCH_NUM"))?1N.N)) Q "-1^Invalid IMP_BATCH_NUM" "RTN","ISIIMPU1",149,0) ; "RTN","ISIIMPU1",150,0) ;-- DFN_NAME -- "RTN","ISIIMPU1",151,0) I $G(ISIMISC("DFN_NAME"))'="" D "RTN","ISIIMPU1",152,0) . S ISIMISC("DFN_NAME")=$TR(ISIMISC("DFN_NAME"),"yn","YN") "RTN","ISIIMPU1",153,0) . I "YN"'[ISIMISC("DFN_NAME") S EXIT=1 Q "RTN","ISIIMPU1",154,0) . Q "RTN","ISIIMPU1",155,0) Q:EXIT "-1^Invalid DFN_NAME ('Y' or 'N')" "RTN","ISIIMPU1",156,0) ; "RTN","ISIIMPU1",157,0) ;-- TYPE -- "RTN","ISIIMPU1",158,0) I $G(ISIMISC("TYPE"))="" S ISIMISC("TYPE")="NON-VETERAN (OTHER)" "RTN","ISIIMPU1",159,0) S FILE="2",FIELD="391",FLAG="",VALUE=ISIMISC("TYPE") "RTN","ISIIMPU1",160,0) D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) "RTN","ISIIMPU1",161,0) Q:'(+RESULT) "-1^Invalid PATIENT TYPE (#2,391)" "RTN","ISIIMPU1",162,0) ; "RTN","ISIIMPU1",163,0) ;-- NAME -- "RTN","ISIIMPU1",164,0) I $G(ISIMISC("NAME"))'="" D "RTN","ISIIMPU1",165,0) . S FIELD=$P(MISCDEF("NAME"),"|",2),VALUE=ISIMISC("NAME") "RTN","ISIIMPU1",166,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",167,0) . Q "RTN","ISIIMPU1",168,0) Q:EXIT "-1^Invalid NAME (#2,.01)" "RTN","ISIIMPU1",169,0) ; "RTN","ISIIMPU1",170,0) ;-- NAME_MASK -- "RTN","ISIIMPU1",171,0) I $G(ISIMISC("NAME_MASK"))=""&($G(ISIMISC("NAME"))="") Q "-1^Must have either NAME or NAME_MASK" "RTN","ISIIMPU1",172,0) ; "RTN","ISIIMPU1",173,0) ;-- SEX -- "RTN","ISIIMPU1",174,0) I $G(ISIMISC("SEX"))'="" D "RTN","ISIIMPU1",175,0) . S FIELD=$P(MISCDEF("SEX"),"|",2),VALUE=ISIMISC("SEX") "RTN","ISIIMPU1",176,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",177,0) . Q "RTN","ISIIMPU1",178,0) Q:EXIT "-1^Invalid SEX (#2,.02)" "RTN","ISIIMPU1",179,0) ; "RTN","ISIIMPU1",180,0) ;-- DOB -- "RTN","ISIIMPU1",181,0) I $G(ISIMISC("DOB"))'="" D "RTN","ISIIMPU1",182,0) . S FIELD=$P(MISCDEF("DOB"),"|",2),VALUE=ISIMISC("DOB") "RTN","ISIIMPU1",183,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU1",184,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",185,0) . Q "RTN","ISIIMPU1",186,0) Q:EXIT "-1^Invalid DOB (#2,.03)" "RTN","ISIIMPU1",187,0) ; "RTN","ISIIMPU1",188,0) ;-- LOW_DOB -- "RTN","ISIIMPU1",189,0) I $G(ISIMISC("LOW_DOB"))'="" D "RTN","ISIIMPU1",190,0) . S FIELD=$P(MISCDEF("LOW_DOB"),"|",2),VALUE=ISIMISC("LOW_DOB") "RTN","ISIIMPU1",191,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU1",192,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",193,0) . I $G(ISIMISC("UP_DOB"))'="" D "RTN","ISIIMPU1",194,0) . . I ISIMISC("LOW_DOB")>ISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPU1",195,0) . Q "RTN","ISIIMPU1",196,0) Q:EXIT "-1^Invalid LOW_DOB (#2,.03)" "RTN","ISIIMPU1",197,0) ; "RTN","ISIIMPU1",198,0) ;-- UP_DOB -- "RTN","ISIIMPU1",199,0) I $G(ISIMISC("UP_DOB"))'="" D "RTN","ISIIMPU1",200,0) . S FIELD=$P(MISCDEF("UP_DOB"),"|",2),VALUE=ISIMISC("UP_DOB") "RTN","ISIIMPU1",201,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU1",202,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",203,0) . I $G(ISIMISC("LOW_DOB"))'="" D "RTN","ISIIMPU1",204,0) . . I ISIMISC("LOW_DOB")>ISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPU1",205,0) . . Q "RTN","ISIIMPU1",206,0) . Q "RTN","ISIIMPU1",207,0) Q:EXIT "-1^Invalid UP_DOB (#2,.03)" "RTN","ISIIMPU1",208,0) ; "RTN","ISIIMPU1",209,0) ;--MARITAL_STATUS-- "RTN","ISIIMPU1",210,0) I $G(ISIMISC("MARITAL_STATUS"))'="" D "RTN","ISIIMPU1",211,0) . S FIELD=$P(MISCDEF("MARITAL_STATUS"),"|",2),VALUE=ISIMISC("MARITAL_STATUS") "RTN","ISIIMPU1",212,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",213,0) . Q "RTN","ISIIMPU1",214,0) Q:EXIT "-1^Invalid MARITAL_STATUS (#2,.05)" "RTN","ISIIMPU1",215,0) ; "RTN","ISIIMPU1",216,0) ;OCCUPATION "RTN","ISIIMPU1",217,0) I $G(ISIMISC("OCCUPATION"))'="" D "RTN","ISIIMPU1",218,0) . S FIELD=$P(MISCDEF("OCCUPATION"),"|",2),VALUE=ISIMISC("OCCUPATION") "RTN","ISIIMPU1",219,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",220,0) . Q "RTN","ISIIMPU1",221,0) Q:EXIT "-1^Invalid OCCUPATION (#2,.07)" "RTN","ISIIMPU1",222,0) ; "RTN","ISIIMPU1",223,0) ;-- RACE -- "RTN","ISIIMPU1",224,0) I $G(ISIMISC("RACE"))'="" D "RTN","ISIIMPU1",225,0) . S FIELD=$P(MISCDEF("RACE"),"|",2) "RTN","ISIIMPU1",226,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) ;race information is multiple "RTN","ISIIMPU1",227,0) . S VALUE=ISIMISC("RACE") "RTN","ISIIMPU1",228,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",229,0) . S FILE=2 ;set back to default "RTN","ISIIMPU1",230,0) . Q "RTN","ISIIMPU1",231,0) Q:EXIT "-1^Invalid RACE INFORMATION (#2.02,.01)" "RTN","ISIIMPU1",232,0) ; "RTN","ISIIMPU1",233,0) ; -- ETHNICITY -- "RTN","ISIIMPU1",234,0) I $G(ISIMISC("ETHNICITY"))'="" D "RTN","ISIIMPU1",235,0) . S FIELD=$P(MISCDEF("ETHNICITY"),"|",2) "RTN","ISIIMPU1",236,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) ;ethnicity information is multiple "RTN","ISIIMPU1",237,0) . S VALUE=ISIMISC("ETHNICITY") "RTN","ISIIMPU1",238,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",239,0) . S FILE=2 ;set back to default "RTN","ISIIMPU1",240,0) . Q "RTN","ISIIMPU1",241,0) Q:EXIT "-1^Invalid ETHNICITY INFORMATION (#2.06,.01)" "RTN","ISIIMPU1",242,0) ; "RTN","ISIIMPU1",243,0) ;-- SSN -- "RTN","ISIIMPU1",244,0) ;I $G(ISIMISC("SSN"))'="" D "RTN","ISIIMPU1",245,0) ;. S FIELD=$P(MISCDEF("SSN"),"|",2),VALUE=ISIMISC("SSN") "RTN","ISIIMPU1",246,0) ;. D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",247,0) ;. Q "RTN","ISIIMPU1",248,0) ;Q:EXIT "-1^Invalid SSN (#2,.09)" "RTN","ISIIMPU1",249,0) "RTN","ISIIMPU1",250,0) I $G(ISIMISC("SSN"))'="" D "RTN","ISIIMPU1",251,0) . I ISIMISC("IMP_TYPE")="B" S EXIT=1,MSG="-1^Can't use full SSN with IMP_TYPE='B' (BATCH)" Q "RTN","ISIIMPU1",252,0) . I $D(^DPT("SSN",$G(ISIMISC("SSN")))) S EXIT=1,MSG="-1^Duplicate SSN" Q "RTN","ISIIMPU1",253,0) . I ISIMISC("SSN")'?1N.N S EXIT=1,MSG="-1^SSN must be numeric." Q "RTN","ISIIMPU1",254,0) . I $L(ISIMISC("SSN"))'=9 S EXIT=1,MSG="-1^SSN must have 9 digits." Q "RTN","ISIIMPU1",255,0) Q:EXIT MSG "RTN","ISIIMPU1",256,0) ; "RTN","ISIIMPU1",257,0) ;-- SSN_MASK -- "RTN","ISIIMPU1",258,0) I $G(ISIMISC("SSN_MASK"))'="" D "RTN","ISIIMPU1",259,0) . S FIELD=4,VALUE=ISIMISC("SSN_MASK") "RTN","ISIIMPU1",260,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",261,0) . Q "RTN","ISIIMPU1",262,0) Q:EXIT "-1^Invalid SSN_MASK" "RTN","ISIIMPU1",263,0) ; "RTN","ISIIMPU1",264,0) ;-- STREET_ADD1 -- "RTN","ISIIMPU1",265,0) I $G(ISIMISC("STREET_ADD1"))'="" D "RTN","ISIIMPU1",266,0) . S FIELD=$P(MISCDEF("STREET_ADD1"),"|",2),VALUE=ISIMISC("STREET_ADD1") "RTN","ISIIMPU1",267,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",268,0) . Q "RTN","ISIIMPU1",269,0) Q:EXIT "-1^Invalid STREET_ADDD1 (#2,.111)" "RTN","ISIIMPU1",270,0) ; "RTN","ISIIMPU1",271,0) ;-- STREET_ADD2 -- "RTN","ISIIMPU1",272,0) I $G(ISIMISC("STREET_ADD2"))'="" D "RTN","ISIIMPU1",273,0) . S FIELD=$P(MISCDEF("STREET_ADD2"),"|",2),VALUE=ISIMISC("STREET_ADD2") "RTN","ISIIMPU1",274,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",275,0) . Q "RTN","ISIIMPU1",276,0) Q:EXIT "-1^Invalid STREET_ADDD2 (#2,.112)" "RTN","ISIIMPU1",277,0) ; "RTN","ISIIMPU1",278,0) ;-- CITY -- "RTN","ISIIMPU1",279,0) I $G(ISIMISC("CITY"))'="" D "RTN","ISIIMPU1",280,0) . S FIELD=$P(MISCDEF("CITY"),"|",2),VALUE=ISIMISC("CITY") "RTN","ISIIMPU1",281,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",282,0) . Q "RTN","ISIIMPU1",283,0) Q:EXIT "-1^Invalid CITY (#2,.114)" "RTN","ISIIMPU1",284,0) ; "RTN","ISIIMPU1",285,0) ;-- STATE -- "RTN","ISIIMPU1",286,0) I $G(ISIMISC("STATE"))'="" D "RTN","ISIIMPU1",287,0) . S FIELD=$P(MISCDEF("STATE"),"|",2),VALUE=ISIMISC("STATE") "RTN","ISIIMPU1",288,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",289,0) . Q "RTN","ISIIMPU1",290,0) Q:EXIT "-1^Invalid STATE (#2,.115)" "RTN","ISIIMPU1",291,0) ; "RTN","ISIIMPU1",292,0) ;-- ZIP_4 -- "RTN","ISIIMPU1",293,0) I $G(ISIMISC("ZIP_4"))'="" D "RTN","ISIIMPU1",294,0) . S FIELD=$P(MISCDEF("ZIP_4"),"|",2),VALUE=ISIMISC("ZIP_4") "RTN","ISIIMPU1",295,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",296,0) . Q "RTN","ISIIMPU1",297,0) Q:EXIT "-1^Invalid ZIP_4 (#2,.1112)" "RTN","ISIIMPU1",298,0) ; "RTN","ISIIMPU1",299,0) ;ZIP_4_MASK "RTN","ISIIMPU1",300,0) I $G(ISIMISC("ZIP_4_MASK"))'="" D "RTN","ISIIMPU1",301,0) . S FIELD=9,VALUE=ISIMISC("ZIP_4_MASK") "RTN","ISIIMPU1",302,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",303,0) . Q "RTN","ISIIMPU1",304,0) Q:EXIT "-1^Invalid ZIP_4_MASK. 5 digits max. Only numbers" "RTN","ISIIMPU1",305,0) ; "RTN","ISIIMPU1",306,0) ;PH_NUM "RTN","ISIIMPU1",307,0) I $G(ISIMISC("PH_NUM"))'="" D "RTN","ISIIMPU1",308,0) . S FIELD=$P(MISCDEF("PH_NUM"),"|",2),VALUE=ISIMISC("PH_NUM") "RTN","ISIIMPU1",309,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",310,0) . Q "RTN","ISIIMPU1",311,0) Q:EXIT "-1^Invalid PH_NUM (#2,.131)" "RTN","ISIIMPU1",312,0) ; "RTN","ISIIMPU1",313,0) ;PH_NUM_MASK "RTN","ISIIMPU1",314,0) I $G(ISIMISC("PH_NUM_MASK"))'="" D "RTN","ISIIMPU1",315,0) . S FIELD=10,VALUE=ISIMISC("PH_NUM_MASK") "RTN","ISIIMPU1",316,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",317,0) . Q "RTN","ISIIMPU1",318,0) Q:EXIT "-1^Invalid PH_NUM_MASK. Numeric between 0 and 999999" "RTN","ISIIMPU1",319,0) ; "RTN","ISIIMPU1",320,0) ;VETERAN "RTN","ISIIMPU1",321,0) I $G(ISIMISC("VETERAN"))'="" D "RTN","ISIIMPU1",322,0) . S VALUE=$$UP^XLFSTR(ISIMISC("VETERAN")) "RTN","ISIIMPU1",323,0) . I VALUE="NO" S VALUE="N" "RTN","ISIIMPU1",324,0) . I VALUE="YES" S VALUE="Y" "RTN","ISIIMPU1",325,0) . S EXIT=$S(VALUE="Y":0,VALUE="N":0,1:1) "RTN","ISIIMPU1",326,0) . Q "RTN","ISIIMPU1",327,0) Q:EXIT "-1^Invalid VETERAN (#2,1901)" "RTN","ISIIMPU1",328,0) ; "RTN","ISIIMPU1",329,0) ;EMPLOY_STAT "RTN","ISIIMPU1",330,0) I $G(ISIMISC("EMPLOY_STAT"))'="" D "RTN","ISIIMPU1",331,0) . S FIELD=$P(MISCDEF("EMPLOY_STAT"),"|",2),VALUE=ISIMISC("EMPLOY_STAT") "RTN","ISIIMPU1",332,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",333,0) . Q "RTN","ISIIMPU1",334,0) Q:EXIT "-1^Invalid EMPLOY_STAT (#2,.31115)" "RTN","ISIIMPU1",335,0) ; "RTN","ISIIMPU1",336,0) ;INSUR_TYPE "RTN","ISIIMPU1",337,0) I $G(ISIMISC("INSUR_TYPE"))'="" D "RTN","ISIIMPU1",338,0) . S FIELD=$P(MISCDEF("INSUR_TYPE"),"|",2),FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) "RTN","ISIIMPU1",339,0) . S VALUE=ISIMISC("INSUR_TYPE") "RTN","ISIIMPU1",340,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",341,0) . S FILE=2 "RTN","ISIIMPU1",342,0) . Q "RTN","ISIIMPU1",343,0) Q:EXIT "-1^Invalid INSUR_TYPE (#2,.3121)" "RTN","ISIIMPU1",344,0) ; "RTN","ISIIMPU1",345,0) Q 0 "RTN","ISIIMPU2") 0^9^B16314614 "RTN","ISIIMPU2",1,0) ISIIMPU2 ;ISI GROUP/MLS -- IMPORT Utility "RTN","ISIIMPU2",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPU2",3,0) Q "RTN","ISIIMPU2",4,0) ; "RTN","ISIIMPU2",5,0) ; Column definitions for MISCDEF table (below): "RTN","ISIIMPU2",6,0) ; NAME= name of parameter "RTN","ISIIMPU2",7,0) ; TYPE = categories of values provided "RTN","ISIIMPU2",8,0) ; 'PARAM' is internal used value "RTN","ISIIMPU2",9,0) ; 'FIELD' is a literal import value "RTN","ISIIMPU2",10,0) ; 'MASK' is dynamic value w/ * wildcard "RTN","ISIIMPU2",11,0) ; DESC = description of value "RTN","ISIIMPU2",12,0) ; "RTN","ISIIMPU2",13,0) ; Array example: "RTN","ISIIMPU2",14,0) ; MISC(1)="ADATE|T-1@12:00" "RTN","ISIIMPU2",15,0) ; MISC(2)="CLIN|PRIMARY CARE" "RTN","ISIIMPU2",16,0) ; MISC(4)="PATIENT|555005555" "RTN","ISIIMPU2",17,0) ; "RTN","ISIIMPU2",18,0) MISCDEF ;;+++++ DEFINITIONS OF APPT MISC PARAMETERS +++++ "RTN","ISIIMPU2",19,0) ;;NAME |TYPE |FILE,FIELD |DESC "RTN","ISIIMPU2",20,0) ;;----------------------------------------------------------------------- "RTN","ISIIMPU2",21,0) ;;ADATE |FIELD |44.001,.01 |Appointment DATE/TIME value "RTN","ISIIMPU2",22,0) ;;CLIN |FIELD |44,.01 |HOSPITAL LOCATION "RTN","ISIIMPU2",23,0) ;;PATIENT |FIELD |2,.09 |PATIENT (SSN or DFN) "RTN","ISIIMPU2",24,0) Q "RTN","ISIIMPU2",25,0) ; "RTN","ISIIMPU2",26,0) APPTMISC(MISC,ISIMISC) "RTN","ISIIMPU2",27,0) ; "RTN","ISIIMPU2",28,0) ;INPUT: "RTN","ISIIMPU2",29,0) ; MISC - raw list values from RPC client "RTN","ISIIMPU2",30,0) ; "RTN","ISIIMPU2",31,0) ;OUTPUT: "RTN","ISIIMPU2",32,0) ; ADATE - Appointment Date/Time "RTN","ISIIMPU2",33,0) ; CLIN - Clinic "RTN","ISIIMPU2",34,0) ; DFN - Patient "RTN","ISIIMPU2",35,0) ; "RTN","ISIIMPU2",36,0) N MISCDEF "RTN","ISIIMPU2",37,0) K ISIMISC "RTN","ISIIMPU2",38,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU2",39,0) S ISIRC=$$APPTMISC1("ISIMISC") "RTN","ISIIMPU2",40,0) Q ISIRC ;return code "RTN","ISIIMPU2",41,0) ; "RTN","ISIIMPU2",42,0) APPTMISC1(DSTNODE) "RTN","ISIIMPU2",43,0) N PARAM,VALUE,DATE,RESULT,MSG,EXIT "RTN","ISIIMPU2",44,0) S (EXIT,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPU2",45,0) F S I=$O(MISC(I)) Q:I="" D Q:EXIT "RTN","ISIIMPU2",46,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPU2",47,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPU2",48,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed: "_PARAM,EXIT=1 Q "RTN","ISIIMPU2",49,0) . I VALUE="" S ISIRC="-1^No data provided for parameter: "_PARAM,EXIT=1 Q "RTN","ISIIMPU2",50,0) . I PARAM="ADATE" D "RTN","ISIIMPU2",51,0) . . S DATE=VALUE D DT^DILF("T",DATE,.RESULT,"",.MSG) "RTN","ISIIMPU2",52,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid appointment date." Q "RTN","ISIIMPU2",53,0) . . I $P(RESULT,".",2)="" S $P(RESULT,".",2)="12" "RTN","ISIIMPU2",54,0) . . S VALUE=RESULT "RTN","ISIIMPU2",55,0) . . D NOW^%DTC I RESULT>% S EXIT=1,ISIRC="-1^Future appointment date not allowed." "RTN","ISIIMPU2",56,0) . . Q "RTN","ISIIMPU2",57,0) . I EXIT Q "RTN","ISIIMPU2",58,0) . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU2",59,0) . Q "RTN","ISIIMPU2",60,0) Q ISIRC ;return code "RTN","ISIIMPU2",61,0) ; "RTN","ISIIMPU2",62,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPU2",63,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPU2",64,0) K MISCDEF "RTN","ISIIMPU2",65,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPU2",66,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPU2",67,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPU2",68,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPU2",69,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPU2",70,0) Q "RTN","ISIIMPU2",71,0) ; "RTN","ISIIMPU2",72,0) VALAPPT() "RTN","ISIIMPU2",73,0) ; Input - ADATE (Appointment date) "RTN","ISIIMPU2",74,0) ; - SC (HOSPITAL LOCATION #44) "RTN","ISIIMPU2",75,0) ; - DFN (SSN or DFN #2) "RTN","ISIIMPU2",76,0) ; Output - ISIRC [return code] "RTN","ISIIMPU2",77,0) ; "RTN","ISIIMPU2",78,0) N EXIT,IDT,RDT "RTN","ISIIMPU2",79,0) S EXIT="" "RTN","ISIIMPU2",80,0) I $G(ADATE)="" Q "-1^Missing date/time for appt." "RTN","ISIIMPU2",81,0) I $G(SC)="" Q "-1^Missing appt. location (#44)." "RTN","ISIIMPU2",82,0) I $G(DFN)="" Q "-1^Missing patient identifier (#2)." "RTN","ISIIMPU2",83,0) ; "RTN","ISIIMPU2",84,0) I $P(ADATE,".",2)="" Q "-1^Missing time for appt." "RTN","ISIIMPU2",85,0) ; check Date/time against fileman date/time field "RTN","ISIIMPU2",86,0) S FILE=2.98,FIELD=.001,VALUE=ADATE "RTN","ISIIMPU2",87,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU2",88,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU2",89,0) . Q "RTN","ISIIMPU2",90,0) Q:EXIT "-1^Invalid appt date/time" "RTN","ISIIMPU2",91,0) ; "RTN","ISIIMPU2",92,0) ; -- SC -- "RTN","ISIIMPU2",93,0) S Y=$O(^SC("B",SC,"")) I Y="" Q "-1^Invalid Appt. location value (#44)." "RTN","ISIIMPU2",94,0) S IDT=$P($G(^SC(Y,"I")),U) "RTN","ISIIMPU2",95,0) S RDT=$P($G(^SC(Y,"I")),U,2) "RTN","ISIIMPU2",96,0) I IDT'="" I RDT="" I IDTIDT I RDT>ADATE Q "-1^Appt. location inactive on appt. date (#44)." "RTN","ISIIMPU2",98,0) I RDT'="" I RDTIDT I RDT>ISIMISC("DT_TAKEN") Q "-1^Location inactive on date vital taken (#44)." "RTN","ISIIMPU5",130,0) I RDT'="" I RDT1)!(Y<0)) Q "-1^Invalid HISTORIC value (0/1)." "RTN","ISIIMPU6",125,0) I Y=1 S ISIMISC("GMRAOBHX")="h^HISTORICAL" "RTN","ISIIMPU6",126,0) I Y=0 S ISIMISC("GMRAOBHX")="o^OBSERVED" "RTN","ISIIMPU6",127,0) ; "RTN","ISIIMPU6",128,0) S ISIMISC("GMRASEVR")=2 "RTN","ISIIMPU6",129,0) ; "RTN","ISIIMPU6",130,0) ; -- OBSRV_DT -- "RTN","ISIIMPU6",131,0) I ISIMISC("HISTORIC")=0,$G(ISIMISC("OBSRV_DT"))="" Q "-1^Missing OBSRV_DT entry." "RTN","ISIIMPU6",132,0) I ISIMISC("HISTORIC")=0 D "RTN","ISIIMPU6",133,0) . S FIELD=$P(MISCDEF("ORIG_DATE"),"|",2),FILE=$P(FIELD,",") ; OBSERV_DT is multiple entry "RTN","ISIIMPU6",134,0) . S FIELD=$P(FIELD,",",2),FLAG="",VALUE=ISIMISC("OBSRV_DT") "RTN","ISIIMPU6",135,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU6",136,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) "RTN","ISIIMPU6",137,0) . I '(+RESULT) S EXIT=1 Q "RTN","ISIIMPU6",138,0) . S ISIMISC("GMRARDT")=ISIMISC("OBSRV_DT") "RTN","ISIIMPU6",139,0) . Q "RTN","ISIIMPU6",140,0) S ISIMISC("GMRACHT",0)=1 "RTN","ISIIMPU6",141,0) D NOW^%DTC S ISIMISC("GMRACHT",1)=% "RTN","ISIIMPU6",142,0) Q:EXIT=1 "-1^Invalid OBSRV_DT." "RTN","ISIIMPU6",143,0) ; "RTN","ISIIMPU6",144,0) Q 1 "RTN","ISIIMPU7") 0^23^B1378159 "RTN","ISIIMPU7",1,0) ISIIMPU7 ;;ISI GROUP/MLS -- IMPORT Utility LABS "RTN","ISIIMPU7",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPU7",3,0) Q "RTN","ISIIMPU7",4,0) MISCDEF ;;+++++ DEFINITIONS OF LAB MISC PARAMETERS +++++ "RTN","ISIIMPU7",5,0) ;;NAME |TYPE |FILE,FIELD |DESC "RTN","ISIIMPU7",6,0) ;;----------------------------------------------------------------------- "RTN","ISIIMPU7",7,0) ;;PAT_SSN |FIELD | |PATIENT (#2) pointer "RTN","ISIIMPU7",8,0) ;;LAB_TEST |FIELD | |Laboratory test name "RTN","ISIIMPU7",9,0) ;;RESULT_DT |FIELD | |Date/time of result "RTN","ISIIMPU7",10,0) ;;RESULT_VAL |FIELD | |Lab test result value "RTN","ISIIMPU7",11,0) ;;LOCATION |FIELD | |Lab test location "RTN","ISIIMPU7",12,0) Q "RTN","ISIIMPU7",13,0) ; "RTN","ISIIMPU7",14,0) LABMISC(MISC,ISIMISC) "RTN","ISIIMPU7",15,0) ;INPUT: "RTN","ISIIMPU7",16,0) ; MISC(0)=PARAM^VALUE - raw list values from RPC client "RTN","ISIIMPU7",17,0) ; "RTN","ISIIMPU7",18,0) ;OUTPUT: "RTN","ISIIMPU7",19,0) ; ISIMISC(PARAM)=VALUE "RTN","ISIIMPU7",20,0) ; "RTN","ISIIMPU7",21,0) N MISCDEF "RTN","ISIIMPU7",22,0) K ISIMISC "RTN","ISIIMPU7",23,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU7",24,0) S ISIRC=$$LABMISC1("ISIMISC") "RTN","ISIIMPU7",25,0) Q ISIRC ;return code "RTN","ISIIMPU7",26,0) ; "RTN","ISIIMPU7",27,0) LABMISC1(DSTNODE) "RTN","ISIIMPU7",28,0) N PARAM,VALUE,DATE,RESULT,MSG,EXIT "RTN","ISIIMPU7",29,0) S (EXIT,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPU7",30,0) F S I=$O(MISC(I)) Q:I="" D Q:EXIT "RTN","ISIIMPU7",31,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPU7",32,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPU7",33,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed: "_PARAM,EXIT=1 Q "RTN","ISIIMPU7",34,0) . I VALUE="" S ISIRC="-1^No data provided for parameter: "_PARAM,EXIT=1 Q "RTN","ISIIMPU7",35,0) . I PARAM="RESULT_DT" D "RTN","ISIIMPU7",36,0) . . S DATE=VALUE D DT^DILF("T",DATE,.RESULT,"",.MSG) "RTN","ISIIMPU7",37,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid "_PARAM_" date/time." Q "RTN","ISIIMPU7",38,0) . . S VALUE=RESULT "RTN","ISIIMPU7",39,0) . . I $P(VALUE,".",2)="" S VALUE=VALUE_".1200" "RTN","ISIIMPU7",40,0) . . Q "RTN","ISIIMPU7",41,0) . I EXIT Q "RTN","ISIIMPU7",42,0) . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU7",43,0) . Q "RTN","ISIIMPU7",44,0) Q ISIRC ;return code "RTN","ISIIMPU7",45,0) ; "RTN","ISIIMPU7",46,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPU7",47,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPU7",48,0) K MISCDEF "RTN","ISIIMPU7",49,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPU7",50,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPU7",51,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPU7",52,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPU7",53,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPU7",54,0) Q "RTN","ISIIMPU7",55,0) ; "RTN","ISIIMPU7",56,0) VALLAB(ISIMISC) "RTN","ISIIMPU7",57,0) ; Entry point to validate content of LAB create/array "RTN","ISIIMPU7",58,0) ; "RTN","ISIIMPU7",59,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMPU7",60,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMPU7",61,0) ; eg: ISIMISC("LAB_TEST")="CHOLESTEROL" "RTN","ISIIMPU7",62,0) ; "RTN","ISIIMPU7",63,0) ; Output - ISIRC [return code] "RTN","ISIIMPU7",64,0) N FILE,FIELD,FLAG,VALUE,RESULT,MSG,MISCDEF,EXIT,TEMP,Y,Z "RTN","ISIIMPU7",65,0) N COLLIEN,SPECIEN,LABNAME,IDT,RDT "RTN","ISIIMPU7",66,0) S EXIT=0 "RTN","ISIIMPU7",67,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU7",68,0) ; "RTN","ISIIMPU7",69,0) ; -- PAT_SSN -- "RTN","ISIIMPU7",70,0) I '$D(ISIMISC("PAT_SSN")) Q "-1^Missing Patient SSN." "RTN","ISIIMPU7",71,0) I $D(ISIMISC("PAT_SSN")) D "RTN","ISIIMPU7",72,0) . S VALUE=$G(ISIMISC("PAT_SSN")) I VALUE="" S EXIT=1 Q "RTN","ISIIMPU7",73,0) . I '$D(^DPT("SSN",VALUE)) S EXIT=1 Q "RTN","ISIIMPU7",74,0) . S DFN=$O(^DPT("SSN",VALUE,"")) I DFN="" S EXIT=1 Q "RTN","ISIIMPU7",75,0) . S ISIMISC("DFN")=DFN "RTN","ISIIMPU7",76,0) . Q "RTN","ISIIMPU7",77,0) Q:EXIT "-1^Invalid PAT_SSN (#2,.09)." "RTN","ISIIMPU7",78,0) ; "RTN","ISIIMPU7",79,0) ; -- LAB_TEST -- "RTN","ISIIMPU7",80,0) I '$D(ISIMISC("LAB_TEST")) Q "-1^Missing LAB_TEST." "RTN","ISIIMPU7",81,0) I $D(ISIMISC("LAB_TEST")) D "RTN","ISIIMPU7",82,0) . S VALUE=$G(ISIMISC("LAB_TEST")) I VALUE="" S EXIT=1,MSG="Missing value for LAB_TEST (#60)." Q "RTN","ISIIMPU7",83,0) . I '$D(^LAB(60,"B",VALUE)) S EXIT=1,MSG="Couldn't find ien for LAB_TEST (#60)." Q "RTN","ISIIMPU7",84,0) . S Y=$O(^LAB(60,"B",VALUE,"")) I Y="" S EXIT=1,MSG="Couldn't find ien for LAB_TEST (#60)." Q "RTN","ISIIMPU7",85,0) . S Z=$P($G(^LAB(60,Y,0)),U,4) I Z'="CH" S EXIT=1,MSG="LAB_TEST incorrect. SUBSCRIPT (#60,4) must by 'CH'." Q "RTN","ISIIMPU7",86,0) . S Z=0,TEMP=Y,Y=$O(^LAB(60,TEMP,3,Z)) I Y="" S EXIT=1,MSG="Couldn't locate COLLECTION SAMPLE (#60.03) for LAB_TEST value." Q "RTN","ISIIMPU7",87,0) . S LABNAME=$P($G(^LAB(60,TEMP,0)),U) "RTN","ISIIMPU7",88,0) . S Z=+$G(^LAB(60,TEMP,3,Y,0)) I Z="" S EXIT=1,MSG="Couldn't locate COLLECTION SAMPLE (#60.03) for LAB_TEST value." Q "RTN","ISIIMPU7",89,0) . S COLLIEN=Z,Y=$G(^LAB(62,COLLIEN,0)) S SPECIEN=$P(Y,U,2) I SPECIEN="" S EXIT=1,MSG="Couldn't locate DEFAULT SPECIMIN (#62,2) for LAB_TEST value." Q "RTN","ISIIMPU7",90,0) . S ISIMISC(1)=TEMP_U_LABNAME_U_COLLIEN_U_U_SPECIEN "RTN","ISIIMPU7",91,0) . S ISIMISC("B",1)=1 ; "RTN","ISIIMPU7",92,0) . S ISIMISC("C",TEMP,1)=1 "RTN","ISIIMPU7",93,0) . Q "RTN","ISIIMPU7",94,0) Q:EXIT "-1^"_MSG "RTN","ISIIMPU7",95,0) ; "RTN","ISIIMPU7",96,0) ; -- RESULT_VAL -- "RTN","ISIIMPU7",97,0) I '$D(ISIMISC("RESULT_VAL")) Q "-1^Missing RESULT_VAL." "RTN","ISIIMPU7",98,0) I $D(ISIMISC("RESULT_VAL")) D "RTN","ISIIMPU7",99,0) . S VALUE=$G(ISIMISC("RESULT_VAL")) I VALUE="" S EXIT=1 Q "RTN","ISIIMPU7",100,0) . ;S Y=VALUE,Z="" "RTN","ISIIMPU7",101,0) . ;I VALUE["." S Y=$P(VALUE,"."),Z=$P(VALUE,".",2) I Z'="" S Z=$E(Z,1,2) I Z'?1N.N S EXIT=1 Q "RTN","ISIIMPU7",102,0) . ;F X=1:1 Q:EXIT!($E(Y,X)="") I $E(Y,X)'?1N S EXIT=1 Q "RTN","ISIIMPU7",103,0) . ;I EXIT Q "RTN","ISIIMPU7",104,0) . ;I Z'="" S VALUE=Y_"."_Z,ISIMISC("RESULT_VAL")=VALUE Q "RTN","ISIIMPU7",105,0) . Q "RTN","ISIIMPU7",106,0) Q:EXIT "-1^Missing RESULT_VAL." "RTN","ISIIMPU7",107,0) ; "RTN","ISIIMPU7",108,0) ; -- RESULT_DT -- "RTN","ISIIMPU7",109,0) I $G(ISIMISC("RESULT_DT"))="" Q "-1^Missing RESULT_DT entry." "RTN","ISIIMPU7",110,0) S FIELD=.01 ;Using another date/time to validate ;$P(MISCDEF("RESULT_DT"),"|",2) "RTN","ISIIMPU7",111,0) S FILE=120.5 ;Using another date/time field to validate; $P(FIELD,",") "RTN","ISIIMPU7",112,0) ; S FIELD=$P(FIELD,",",2) "RTN","ISIIMPU7",113,0) S FLAG="",VALUE=ISIMISC("RESULT_DT") "RTN","ISIIMPU7",114,0) S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU7",115,0) D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) "RTN","ISIIMPU7",116,0) Q:'(+RESULT) "-1^Invalid RESULT_DT" "RTN","ISIIMPU7",117,0) ; "RTN","ISIIMPU7",118,0) ; -- ENTERED_BY -- "RTN","ISIIMPU7",119,0) I '$D(^XUSEC("LRLAB",DUZ))&('$D(^XUSEC("LRVERIFY",DUZ))) Q "-1^Invalid ENTERED_BY (#200,.01). Insufficient privilages." "RTN","ISIIMPU7",120,0) S ISIMISC("INITIALS")=$P($G(^VA(200,DUZ,0)),U,2) "RTN","ISIIMPU7",121,0) ; "RTN","ISIIMPU7",122,0) ; -- LOCATION -- "RTN","ISIIMPU7",123,0) I '$D(ISIMISC("LOCATION")) Q "-1^Missing LOCATION." "RTN","ISIIMPU7",124,0) I $D(ISIMISC("LOCATION")) D "RTN","ISIIMPU7",125,0) . S VALUE=$G(ISIMISC("LOCATION")) I VALUE="" S EXIT=1 Q "RTN","ISIIMPU7",126,0) . S Y=$O(^SC("B",VALUE,"")) I Y="" S EXIT=1 Q "RTN","ISIIMPU7",127,0) . S IDT=$P($G(^SC(Y,"I")),U) "RTN","ISIIMPU7",128,0) . S RDT=$P($G(^SC(Y,"I")),U,2) "RTN","ISIIMPU7",129,0) . I IDT'="" I RDT="" I IDT
IDT I RDT>DT S EXIT=1 Q "RTN","ISIIMPU7",131,0) . I RDT'="" I RDTIDT I RDT>DT S EXIT=1 Q "RTN","ISIIMPU8",105,0) . I RDT'="" I RDT0 "-1^Note requires co-signature." "RTN","ISIIMPU8",139,0) ; "RTN","ISIIMPU8",140,0) Q 1 "RTN","ISIIMPU9") 0^25^B2509079 "RTN","ISIIMPU9",1,0) ISIIMPU9 ;;ISI GROUP/MLS -- MED IMPORT Utility "RTN","ISIIMPU9",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPU9",3,0) Q "RTN","ISIIMPU9",4,0) MISCDEF ;;+++++ DEFINITIONS OF MED MISC PARAMETERS +++++ "RTN","ISIIMPU9",5,0) ;;NAME |TYPE |FILE,FIELD |DESC "RTN","ISIIMPU9",6,0) ;;----------------------------------------------------------------------- "RTN","ISIIMPU9",7,0) ;;PAT_SSN |FIELD |2,.09 |Patient SSN (identifier) "RTN","ISIIMPU9",8,0) ;;DRUG |FIELD |50,.01 |Generic Name "RTN","ISIIMPU9",9,0) ;;DATE |FIELD | |Multiple uses (issue, dispense, fill) "RTN","ISIIMPU9",10,0) ;;EXPIRDT |FIELD |50,17.1 |Expiration Date "RTN","ISIIMPU9",11,0) ;;SIG |FIELD |51,.01 |Medication Instruction name "RTN","ISIIMPU9",12,0) ;;QTY |FIELD | |Quantity. Must be a number "RTN","ISIIMPU9",13,0) ;;SUPPLY |FIELD | |# of Days supply. Must be a number "RTN","ISIIMPU9",14,0) ;;REFILL |FIELD | |# of refills. Must be a number. "RTN","ISIIMPU9",15,0) ;;PROV |FIELD |200,.01 |Provider "RTN","ISIIMPU9",16,0) Q "RTN","ISIIMPU9",17,0) ; "RTN","ISIIMPU9",18,0) MEDMISC(MISC,ISIMISC) "RTN","ISIIMPU9",19,0) ;INPUT: "RTN","ISIIMPU9",20,0) ; MISC(0)=PARAM^VALUE - raw list ovalues from RPC client "RTN","ISIIMPU9",21,0) ; "RTN","ISIIMPU9",22,0) ;OUTPUT: "RTN","ISIIMPU9",23,0) ; ISIMISC(PARAM)=VALUE "RTN","ISIIMPU9",24,0) ; "RTN","ISIIMPU9",25,0) N MISCDEF "RTN","ISIIMPU9",26,0) K ISIMISC "RTN","ISIIMPU9",27,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU9",28,0) S ISIRC=$$MEDMISC1("ISIMISC") "RTN","ISIIMPU9",29,0) Q ISIRC ;return code "RTN","ISIIMPU9",30,0) ; "RTN","ISIIMPU9",31,0) MEDMISC1(DSTNODE) "RTN","ISIIMPU9",32,0) N PARAM,VALUE,DATE,RESULT,MSG,EXIT "RTN","ISIIMPU9",33,0) S (EXIT,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPU9",34,0) F S I=$O(MISC(I)) Q:I="" D Q:EXIT "RTN","ISIIMPU9",35,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPU9",36,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPU9",37,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed: "_PARAM,EXIT=1 Q "RTN","ISIIMPU9",38,0) . I VALUE="" S ISIRC="-1^No data provided for parameter: "_PARAM,EXIT=1 Q "RTN","ISIIMPU9",39,0) . I PARAM="DATE" D "RTN","ISIIMPU9",40,0) . . S DATE=VALUE D DT^DILF("T",DATE,.RESULT,"",.MSG) "RTN","ISIIMPU9",41,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid "_PARAM_" date/time." Q "RTN","ISIIMPU9",42,0) . . S VALUE=RESULT "RTN","ISIIMPU9",43,0) . . I $P(VALUE,".",2)="" S VALUE=VALUE_".1200" "RTN","ISIIMPU9",44,0) . . Q "RTN","ISIIMPU9",45,0) . I PARAM="EXPIRDT" D "RTN","ISIIMPU9",46,0) . . S DATE=VALUE D DT^DILF("T",DATE,.RESULT,"",.MSG) "RTN","ISIIMPU9",47,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid "_PARAM_" date." Q "RTN","ISIIMPU9",48,0) . . S VALUE=RESULT "RTN","ISIIMPU9",49,0) . . Q "RTN","ISIIMPU9",50,0) . I EXIT Q "RTN","ISIIMPU9",51,0) . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU9",52,0) . Q "RTN","ISIIMPU9",53,0) Q ISIRC ;return code "RTN","ISIIMPU9",54,0) ; "RTN","ISIIMPU9",55,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPU9",56,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPU9",57,0) K MISCDEF "RTN","ISIIMPU9",58,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPU9",59,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPU9",60,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPU9",61,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPU9",62,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPU9",63,0) Q "RTN","ISIIMPU9",64,0) ; "RTN","ISIIMPU9",65,0) VALMEDS(ISIMISC) "RTN","ISIIMPU9",66,0) ; Entry point to validate content of MEDS create array "RTN","ISIIMPU9",67,0) ; "RTN","ISIIMPU9",68,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMPU9",69,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMPU9",70,0) ; eg: ISIMISC("DRUG")="ASPRIN" "RTN","ISIIMPU9",71,0) ; "RTN","ISIIMPU9",72,0) ; Output - ISIRC [return code] "RTN","ISIIMPU9",73,0) N FILE,FIELD,FLAG,DFN,VALUE,RESULT,MSG,MISCDEF,EXIT,Y,RESULT,PSOSITE "RTN","ISIIMPU9",74,0) S EXIT=0,FLAG="" "RTN","ISIIMPU9",75,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU9",76,0) ; "RTN","ISIIMPU9",77,0) ; -- PAT_SSN -- "RTN","ISIIMPU9",78,0) I '$D(ISIMISC("PAT_SSN")) Q "-1^Missing Patient SSN." "RTN","ISIIMPU9",79,0) I $D(ISIMISC("PAT_SSN")) D "RTN","ISIIMPU9",80,0) . S VALUE=$G(ISIMISC("PAT_SSN")) I VALUE="" S EXIT=1 Q "RTN","ISIIMPU9",81,0) . I '$D(^DPT("SSN",VALUE)) S EXIT=1 Q "RTN","ISIIMPU9",82,0) . S DFN=$O(^DPT("SSN",VALUE,"")) I DFN="" S EXIT=1 Q "RTN","ISIIMPU9",83,0) . S ISIMISC("DFN")=DFN "RTN","ISIIMPU9",84,0) . Q "RTN","ISIIMPU9",85,0) Q:EXIT "-1^Invalid PAT_SSN (#2,.09)." "RTN","ISIIMPU9",86,0) ; "RTN","ISIIMPU9",87,0) ; -- DRUG -- "RTN","ISIIMPU9",88,0) I $G(ISIMISC("DRUG"))="" Q "-1^Missing DRUG (#50,.01) value." "RTN","ISIIMPU9",89,0) I $D(ISIMISC("DRUG")) D "RTN","ISIIMPU9",90,0) . S VALUE=ISIMISC("DRUG"),VALUE=$O(^PSDRUG("B",VALUE,"")) "RTN","ISIIMPU9",91,0) . I VALUE="" S EXIT=1 Q "RTN","ISIIMPU9",92,0) . I $P($G(^PSDRUG(VALUE,2)),U,1)="" S EXIT=1 Q ;Missing pointer to Orderable item #50.7 "RTN","ISIIMPU9",93,0) . I $P($G(^PSDRUG(VALUE,0)),U,3)="" S EXIT=1 Q ;Missing DEA value "RTN","ISIIMPU9",94,0) . I $P($G(^PSDRUG(VALUE,660)),U,6)="" S EXIT=1 Q ;Missing unit price "RTN","ISIIMPU9",95,0) . S ISIMISC("DRUG")=VALUE "RTN","ISIIMPU9",96,0) . Q "RTN","ISIIMPU9",97,0) Q:EXIT "-1^Invalid DRUG (#50,.01) value." "RTN","ISIIMPU9",98,0) ; "RTN","ISIIMPU9",99,0) ; -- DATE -- "RTN","ISIIMPU9",100,0) I $G(ISIMISC("DATE"))="" Q "-1^Missing Fill Date" "RTN","ISIIMPU9",101,0) I $G(ISIMISC("EXPIRDT"))="" Q "-1^Missing Expire Date" "RTN","ISIIMPU9",102,0) ; "RTN","ISIIMPU9",103,0) ; -- SIG -- "RTN","ISIIMPU9",104,0) I $G(ISIMISC("SIG"))="" Q "-1^Missing SIG (#51,.01) value." "RTN","ISIIMPU9",105,0) I $D(ISIMISC("SIG")) D "RTN","ISIIMPU9",106,0) . S FIELD=$P(MISCDEF("SIG"),"|",2) "RTN","ISIIMPU9",107,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) "RTN","ISIIMPU9",108,0) . S VALUE=ISIMISC("SIG") "RTN","ISIIMPU9",109,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU9",110,0) . S VALUE=$O(^PS(51,"B",VALUE,"")) "RTN","ISIIMPU9",111,0) . I $P(^PS(51,VALUE,0),U,4)>1 S EXIT=1 Q ;#51,30 Intended use is Inpatient only "RTN","ISIIMPU9",112,0) . Q "RTN","ISIIMPU9",113,0) Q:EXIT "-1^Invalid Medication Instruction/SIG (#51,.01) value." "RTN","ISIIMPU9",114,0) ; "RTN","ISIIMPU9",115,0) ; -- QTY -- "RTN","ISIIMPU9",116,0) I $G(ISIMISC("QTY"))="" Q "-1^Missing QTY (quantity) value." "RTN","ISIIMPU9",117,0) S VALUE=ISIMISC("QTY") I VALUE'?1N.N Q "-1^Invalid QTY (quantity) value. Must be number." "RTN","ISIIMPU9",118,0) ; "RTN","ISIIMPU9",119,0) ; -- SUPPLY -- "RTN","ISIIMPU9",120,0) I $G(ISIMISC("SUPPLY"))="" Q "-1^Missing SUPPLY (DAYS SUPPLY) value." "RTN","ISIIMPU9",121,0) S VALUE=ISIMISC("SUPPLY") I VALUE'?1N.N Q "-1^Invalid SUPPLY (DAYS SUPPLY)value. Must be number." "RTN","ISIIMPU9",122,0) ; "RTN","ISIIMPU9",123,0) ; -- REFILL -- "RTN","ISIIMPU9",124,0) I $G(ISIMISC("REFILL"))="" Q "-1^Missing REFILL (# of refills) value." "RTN","ISIIMPU9",125,0) S VALUE=ISIMISC("QTY") I VALUE'?1N.N Q "-1^Invalid REFILL (# or refills) value. Must be number." "RTN","ISIIMPU9",126,0) ; "RTN","ISIIMPU9",127,0) ; -- PROV -- "RTN","ISIIMPU9",128,0) I $G(ISIMISC("PROV"))'="" D "RTN","ISIIMPU9",129,0) . S FIELD=$P(MISCDEF("PROV"),"|",2) "RTN","ISIIMPU9",130,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) "RTN","ISIIMPU9",131,0) . S VALUE=ISIMISC("PROV") "RTN","ISIIMPU9",132,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU9",133,0) . ;if multiple entries, check for valid entry "RTN","ISIIMPU9",134,0) . S EXIT=1 "RTN","ISIIMPU9",135,0) . S Y=0 F S Y=$O(^VA(200,"B",VALUE,Y)) Q:Y="" D "RTN","ISIIMPU9",136,0) . . I +$G(^VA(200,Y,"PS"))'=1 Q ;Authorized to write medical orders check "RTN","ISIIMPU9",137,0) . . S EXIT=0,ISIMISC("PROV")=Y "RTN","ISIIMPU9",138,0) . . Q "RTN","ISIIMPU9",139,0) I $G(ISIMISC("PROV"))="" D "RTN","ISIIMPU9",140,0) . S EXIT=1 "RTN","ISIIMPU9",141,0) . I +$G(^VA(200,DUZ,"PS"))'=1 Q ; "RTN","ISIIMPU9",142,0) . S ISIMISC("PROV")=DUZ,EXIT=0 "RTN","ISIIMPU9",143,0) . Q "RTN","ISIIMPU9",144,0) Q:EXIT "-1^Invalid PROVIDER (#200,.01)." "RTN","ISIIMPU9",145,0) ; "RTN","ISIIMPU9",146,0) S PSOSITE=0 F S PSOSITE=$O(^PS(59,PSOSITE)) Q:'PSOSITE D I $G(ISIMISC("PSOSITE"))'="" Q "RTN","ISIIMPU9",147,0) . S Y=+$G(^PS(59,PSOSITE,"I")) "RTN","ISIIMPU9",148,0) . I Y="" S ISIMISC("PSOSITE")=PSOSITE Q "RTN","ISIIMPU9",149,0) . I Y>DT Q "RTN","ISIIMPU9",150,0) . S ISIMISC("PSOSITE")=PSOSITE "RTN","ISIIMPU9",151,0) . Q "RTN","ISIIMPU9",152,0) Q:$G(ISIMISC("PSOSITE"))="" "-1^Can't locate valid OUTPATIENT SITE FILE (#59)." "RTN","ISIIMPU9",153,0) ; "RTN","ISIIMPU9",154,0) Q 1 "RTN","ISIIMPUA") 0^37^B4098 "RTN","ISIIMPUA",1,0) ISIIMPUA ;ISI GROUP/MLS -- Data Loader File Fetch "RTN","ISIIMPUA",2,0) ;;1.0;;;Jun 26,2012;Build 30 "RTN","ISIIMPUA",3,0) ; Grabs local VistA file content to populate external import select lists "RTN","ISIIMPUA",4,0) ; "RTN","ISIIMPUA",5,0) Q "RTN","ISIIMPUA",6,0) ; "RTN","ISIIMPUA",7,0) PARAM(TABLE) "RTN","ISIIMPUA",8,0) ;INPUT: "RTN","ISIIMPUA",9,0) ; TABLE="NOTE" - txt to designate VistA file fetched "RTN","ISIIMPUA",10,0) ; "RTN","ISIIMPUA",11,0) ;OUTPUT: "RTN","ISIIMPUA",12,0) ; # -- Number of resolved entry (1-22) "RTN","ISIIMPUA",13,0) ; "RTN","ISIIMPUA",14,0) S TABLE=$$UP^XLFSTR(TABLE) "RTN","ISIIMPUA",15,0) S TABLE=$$TRIM^XLFSTR(TABLE) "RTN","ISIIMPUA",16,0) I TABLE="NOTE" Q 1 ;TIULIST "RTN","ISIIMPUA",17,0) I TABLE="DRUG" Q 2 ;DRUGLIST "RTN","ISIIMPUA",18,0) I TABLE="SIG" Q 3 ;SIGLIST "RTN","ISIIMPUA",19,0) I TABLE="PROV" Q 4 ;PROVLIST "RTN","ISIIMPUA",20,0) I TABLE="USER" Q 5 ;USERLIST "RTN","ISIIMPUA",21,0) I TABLE="RACE" Q 6 ;RACE "RTN","ISIIMPUA",22,0) I TABLE="ETHN" Q 7 ;ETHNICITY "RTN","ISIIMPUA",23,0) I TABLE="EMPLOY" Q 8 ;EMPLOYSTAT "RTN","ISIIMPUA",24,0) I TABLE="INSUR" Q 9 ;INSURANCE "RTN","ISIIMPUA",25,0) I TABLE="LOC" Q 10 ;LOCATION "RTN","ISIIMPUA",26,0) I TABLE="ICD9" Q 11 ;ICD9 "RTN","ISIIMPUA",27,0) I TABLE="VITAL" Q 12 ;VITALTYPE "RTN","ISIIMPUA",28,0) I TABLE="ALLER" Q 13 ;ALLERGEN "RTN","ISIIMPUA",29,0) I TABLE="SYMP" Q 14 ;SYMPTOM "RTN","ISIIMPUA",30,0) I TABLE="LAB" Q 15 ;LABTESTS "RTN","ISIIMPUA",31,0) I TABLE="GENDER" Q 16 ;GENDER "RTN","ISIIMPUA",32,0) I TABLE="BOOL" Q 17 ;BOOLEEN "RTN","ISIIMPUA",33,0) I TABLE="PROBSTAT" Q 18 ;PROBSTAT "RTN","ISIIMPUA",34,0) I TABLE="PROBTYPE" Q 19 ;PROBTYPE "RTN","ISIIMPUA",35,0) I TABLE="CONSULT" Q 20 ; "RTN","ISIIMPUA",36,0) I TABLE="MAGLOC" Q 21 "RTN","ISIIMPUA",37,0) I TABLE="RADPROC" Q 22 "RTN","ISIIMPUA",38,0) Q -1 "RTN","ISIIMPUA",39,0) ; "RTN","ISIIMPUA",40,0) ENTRY(ARRAY,LIST) "RTN","ISIIMPUA",41,0) ;INPUT: "RTN","ISIIMPUA",42,0) ; ARRAY = output Array "RTN","ISIIMPUA",43,0) ; LIST = numeric to choose FILE "RTN","ISIIMPUA",44,0) ; "RTN","ISIIMPUA",45,0) ;OUTPUT: "RTN","ISIIMPUA",46,0) ; ARRAY(0)=CNT ;numeric "RTN","ISIIMPUA",47,0) ; ARRAY(1)=VALUE ;text "RTN","ISIIMPUA",48,0) ; "RTN","ISIIMPUA",49,0) I LIST'?1N.N S ARRAY(0)="-1^Incorrect parameter passed" Q "RTN","ISIIMPUA",50,0) I LIST=1 D TIULIST Q "RTN","ISIIMPUA",51,0) I LIST=2 D DRUGLIST Q "RTN","ISIIMPUA",52,0) I LIST=3 D SIGLIST Q "RTN","ISIIMPUA",53,0) I LIST=4 D PROVLIST Q "RTN","ISIIMPUA",54,0) I LIST=5 D USERLIST Q "RTN","ISIIMPUA",55,0) I LIST=6 D RACE Q "RTN","ISIIMPUA",56,0) I LIST=7 D ETHNICITY Q "RTN","ISIIMPUA",57,0) I LIST=8 D EMPLOYSTAT Q "RTN","ISIIMPUA",58,0) I LIST=9 D INSURANCE Q "RTN","ISIIMPUA",59,0) I LIST=10 D LOCATION Q "RTN","ISIIMPUA",60,0) I LIST=11 D ICD9 Q "RTN","ISIIMPUA",61,0) I LIST=12 D VITALTYPE Q "RTN","ISIIMPUA",62,0) I LIST=13 D ALLERGEN Q "RTN","ISIIMPUA",63,0) I LIST=14 D SYMPTOM Q "RTN","ISIIMPUA",64,0) I LIST=15 D LABTESTS Q "RTN","ISIIMPUA",65,0) I LIST=16 D GENDER Q "RTN","ISIIMPUA",66,0) I LIST=17 D BOOLEEN Q "RTN","ISIIMPUA",67,0) I LIST=18 D PROBSTAT Q "RTN","ISIIMPUA",68,0) I LIST=19 D PROBTYPE Q "RTN","ISIIMPUA",69,0) I LIST=20 D CONSULT Q "RTN","ISIIMPUA",70,0) I LIST=21 D IMAGLOC Q ; "RTN","ISIIMPUA",71,0) I LIST=22 D RAPROC Q ; "RTN","ISIIMPUA",72,0) S ARRAY(0)="-1^Incorrect parameter passed" Q "RTN","ISIIMPUA",73,0) Q "RTN","ISIIMPUA",74,0) ; "RTN","ISIIMPUA",75,0) HDR ;not used -- was thinking about producing entire "TABLES" worksheet as output "RTN","ISIIMPUA",76,0) S HDR="Gender,Booleen,Race,Ethnicity,Employ_Status,Insurance,Location,Person,ICD9_Desc,Problem_status,Problem_Type,Vital_type" "RTN","ISIIMPUA",77,0) S HDR=HDR_",Allergen,Symptom,Lab_test,Case,Note_title,drug_list,siglist" "RTN","ISIIMPUA",78,0) Q "RTN","ISIIMPUA",79,0) ; "RTN","ISIIMPUA",80,0) TIULIST ;#8925.1 "RTN","ISIIMPUA",81,0) N VALUE,IEN,RESULT,CNT "RTN","ISIIMPUA",82,0) S VALUE="",CNT=0 "RTN","ISIIMPUA",83,0) F S VALUE=$O(^TIU(8925.1,"B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",84,0) . S IEN=$O(^TIU(8925.1,"B",VALUE,"")) I IEN="" Q "RTN","ISIIMPUA",85,0) . N ZREC S ZREC=$G(^TIU(8925.1,IEN,0)) I ZREC="" Q "RTN","ISIIMPUA",86,0) . I $P(ZREC,U,4)'="DOC" Q ; TIU Type of DOC "RTN","ISIIMPUA",87,0) . I $P(ZREC,U,7)'=11 Q ;TIU status of Active "RTN","ISIIMPUA",88,0) . N RESULT D ISCNSLT^TIUCNSLT(.RESULT,IEN) I RESULT'=0 Q ;No CONSULT types "RTN","ISIIMPUA",89,0) . S CNT=CNT+1 S ARRAY(CNT)=VALUE "RTN","ISIIMPUA",90,0) S ARRAY(0)=CNT I CNT=0 S ARRAY(0)="-1^No results found." "RTN","ISIIMPUA",91,0) Q "RTN","ISIIMPUA",92,0) ; "RTN","ISIIMPUA",93,0) DRUGLIST ;#50 "RTN","ISIIMPUA",94,0) N VALUE,IEN,CNT "RTN","ISIIMPUA",95,0) S VALUE="",CNT=0 "RTN","ISIIMPUA",96,0) F S VALUE=$O(^PSDRUG("B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",97,0) . S IEN=$O(^PSDRUG("B",VALUE,"")) "RTN","ISIIMPUA",98,0) . I $P($G(^PSDRUG(IEN,2)),"^",1)="" Q ;Missing pointer to Orderable item #50.7 "RTN","ISIIMPUA",99,0) . I $P($G(^PSDRUG(IEN,0)),"^",3)="" Q ;Missing DEA value "RTN","ISIIMPUA",100,0) . I $P($G(^PSDRUG(IEN,660)),"^",6)="" Q ;Missing unit price "RTN","ISIIMPUA",101,0) . S CNT=CNT+1 S ARRAY(CNT)=VALUE "RTN","ISIIMPUA",102,0) . Q "RTN","ISIIMPUA",103,0) S ARRAY(0)=CNT I CNT=0 S ARRAY(0)="-1^No results found." "RTN","ISIIMPUA",104,0) Q "RTN","ISIIMPUA",105,0) ; "RTN","ISIIMPUA",106,0) SIGLIST ;#51 "RTN","ISIIMPUA",107,0) N VALUE,IEN,CNT "RTN","ISIIMPUA",108,0) S VALUE="",CNT=0 "RTN","ISIIMPUA",109,0) F S VALUE=$O(^PS(51,"B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",110,0) . S IEN=$O(^PS(51,"B",VALUE,"")) "RTN","ISIIMPUA",111,0) . I $P(^PS(51,IEN,0),U,4)>1 Q ;#51,30 Intended use is Inpatient only "RTN","ISIIMPUA",112,0) . S CNT=CNT+1 S ARRAY(CNT)=VALUE "RTN","ISIIMPUA",113,0) . Q "RTN","ISIIMPUA",114,0) S ARRAY(0)=CNT I CNT=0 S ARRAY(0)="-1^No results found." "RTN","ISIIMPUA",115,0) Q "RTN","ISIIMPUA",116,0) ; "RTN","ISIIMPUA",117,0) PROVLIST ;#200 "RTN","ISIIMPUA",118,0) N VALUE,IEN,DTC,IDT,CNT,NAME "RTN","ISIIMPUA",119,0) D NOW^%DTC S DTC=X,VALUE="",CNT=0 "RTN","ISIIMPUA",120,0) F S VALUE=$O(^VA(200,"B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",121,0) . S IEN=$O(^VA(200,"B",VALUE,"")) "RTN","ISIIMPUA",122,0) . I +$G(^VA(200,IEN,"PS"))'=1 Q ;Authorized to write medical orders check "RTN","ISIIMPUA",123,0) . S IDT=$P($G(^VA(200,IEN,"PS")),U,4) I IDT'="" I IDTIDT I RDT>DTC Q "RTN","ISIIMPUA",196,0) . I RDT'="" I RDTIDT I RDT>DT S EXIT=1 Q "RTN","ISIIMPUB",98,0) . I RDT'="" I RDTIDT I RDT>TDY S EXIT=1 Q "RTN","ISIIMPUC",145,0) . I RDT'="" I RDT30!($L(X)<3)!'(X'?1P.E) X "^DD",9001,9001,.01,1,0) ^.1 "^DD",9001,9001,.01,1,1,0) 9001^B "^DD",9001,9001,.01,1,1,1) S ^ISI(9001,"B",$E(X,1,30),DA)="" "^DD",9001,9001,.01,1,1,2) K ^ISI(9001,"B",$E(X,1,30),DA) "^DD",9001,9001,.01,3) Answer must be 3-30 characters in length. "^DD",9001,9001,.01,"DT") 3120524 "^DD",9001,9001,1,0) TYPE^P391'^DG(391,^0;2^Q "^DD",9001,9001,1,.1) PT TYPE "^DD",9001,9001,1,3) "^DD",9001,9001,1,21,0) ^.001^1^1^3120524^^ "^DD",9001,9001,1,21,1,0) Type of tmplate for patient import. 'F' when all minimal fields required to create a record are present. 'P' when only a partial set is provided. "^DD",9001,9001,1,"DT") 3120524 "^DD",9001,9001,2,0) NAME MASK^F^^0;3^K:$L(X)>20!($L(X)<3) X "^DD",9001,9001,2,3) Answer must be 3-20 characters in length. "^DD",9001,9001,2,21,0) ^.001^1^1^3120529^^^ "^DD",9001,9001,2,21,1,0) Last name mask for auto-generation of Patient Last names. "^DD",9001,9001,2,"DT") 3120529 "^DD",9001,9001,4,0) SSN MASK^NJ5,0^^0;5^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."1N.N) X "^DD",9001,9001,4,3) Type a Number between 0 and 99999, 0 Decimal Digits "^DD",9001,9001,4,21,0) ^^1^1^3120524^ "^DD",9001,9001,4,21,1,0) SSN mask for the five digits of SSN for patients created. "^DD",9001,9001,4,"DT") 3120524 "^DD",9001,9001,5,0) SEX^S^M:MALE;F:FEMALE;^0;6^Q "^DD",9001,9001,5,"DT") 3120524 "^DD",9001,9001,6,0) EARLIEST DATE OF BIRTH^D^^0;7^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",9001,9001,6,.1) EARLIEST DOB "^DD",9001,9001,6,3) TYPE A DATE BETWEEN 12/31/1870 AND 5/24/2032 "^DD",9001,9001,6,"DT") 3120524 "^DD",9001,9001,7,0) LATEST DATE OF BIRTH^D^^0;8^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",9001,9001,7,"DT") 3120524 "^DD",9001,9001,8,0) MARITAL STATUS^P11'^DIC(11,^0;9^Q "^DD",9001,9001,8,"DT") 3120524 "^DD",9001,9001,9,0) ZIP+4 MASK^NJ5,0^^0;10^K:+X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N) X "^DD",9001,9001,9,3) Type a Number between 1 and 99999, 0 Decimal Digits "^DD",9001,9001,9,"DT") 3120524 "^DD",9001,9001,10,0) PHONE NUMBER [RESIDENCE] MASK^NJ6,0^^0;11^K:+X'=X!(X>999999)!(X<0)!(X?.E1"."1N.N) X "^DD",9001,9001,10,3) Type a Number between 0 and 999999, 0 Decimal Digits "^DD",9001,9001,10,"DT") 3120529 "^DD",9001,9001,11,0) CITY^F^^0;12^K:$L(X)>15!($L(X)<2) X "^DD",9001,9001,11,3) Answer must be 2-15 characters in length. "^DD",9001,9001,11,"DT") 3120524 "^DD",9001,9001,12,0) STATE^P5'^DIC(5,^0;13^Q "^DD",9001,9001,12,"DT") 3120524 "^DD",9001,9001,13,0) VETERAN^S^Y:YES;N:NO;^0;14^Q "^DD",9001,9001,13,"DT") 3120524 "^DD",9001,9001,14,0) DFN_NAME^S^Y:Y;N:N;^0;4^Q "^DD",9001,9001,14,21,0) ^^1^1^3120605^ "^DD",9001,9001,14,21,1,0) Determines whether the name mask value is derived from the DFN value. "^DD",9001,9001,14,"DT") 3120605 "^DD",9001,9001,15,0) EMPLOYMENT STATUS^S^1:EMPLOYED FULL TIME;2:EMPLOYED PART TIME;3:NOT EMPLOYED;4:SELF EMPLOYED;5:RETIRED;6:ACTIVE MILITARY DUTY;9:UNKNOWN;^0;15^Q "^DD",9001,9001,15,3) "^DD",9001,9001,15,"DT") 3120606 "^DIC",9001,9001,0) ISI PT IMPORT TEMPLATE^9001 "^DIC",9001,9001,0,"GL") ^ISI(9001, "^DIC",9001,9001,"%",0) ^1.005^^0 "^DIC",9001,9001,"%D",0) ^1.001^1^1^3120524^^^^ "^DIC",9001,9001,"%D",1,0) Stores default information for Import APIs "^DIC",9001,"B","ISI PT IMPORT TEMPLATE",9001) **END** **END**