KIDS Distribution saved on Aug 02, 2015@13:57:04 export on 8/2/2015 **KIDS**:ISI_DATA_LOADER 2.5^ **INSTALL NAME** ISI_DATA_LOADER 2.5 "BLD",8863,0) ISI_DATA_LOADER 2.5^^0^3150802^n "BLD",8863,1,0) ^^50^50^3150802^^^^ "BLD",8863,1,1,0) VistA Data Loader Tool 2.0 "BLD",8863,1,2,0) "BLD",8863,1,3,0) VistA Data Loader is provided by the Johns Hopkins University School of "BLD",8863,1,4,0) Nursing, and funded by the Department of Health and Human Services, "BLD",8863,1,5,0) Office of the National Coordinator for Health Information Technology "BLD",8863,1,6,0) under Award Number #1U24OC000013-01. "BLD",8863,1,7,0) Copyright (C) 2012 Johns Hopkins University Johns Hopkins University "BLD",8863,1,8,0) "BLD",8863,1,9,0) All portions of this release that are modified from the original Freedom "BLD",8863,1,10,0) of Information Act release provided by the Department of Veterans Affairs "BLD",8863,1,11,0) is subject to the terms of the GNU Affero General Public License as "BLD",8863,1,12,0) published by the Free Software Foundation, either version 3 of the "BLD",8863,1,13,0) License, or any later version. "BLD",8863,1,14,0) This program is distributed in the hope that it will be useful, but "BLD",8863,1,15,0) WITHOUT ANY WARRANTY; without even the implied warranty of "BLD",8863,1,16,0) MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero "BLD",8863,1,17,0) General Public License for more details. "BLD",8863,1,18,0) You should have received a copy of the GNU Affero General Public License "BLD",8863,1,19,0) along with this program. If not, see http://www.gnu.org/licenses/. "BLD",8863,1,20,0) "BLD",8863,1,21,0) "BLD",8863,1,22,0) "BLD",8863,1,23,0) "BLD",8863,1,24,0) "BLD",8863,1,25,0) "BLD",8863,1,26,0) "BLD",8863,1,27,0) "BLD",8863,1,28,0) "BLD",8863,1,29,0) "BLD",8863,1,30,0) "BLD",8863,1,31,0) "BLD",8863,1,32,0) "BLD",8863,1,33,0) "BLD",8863,1,34,0) "BLD",8863,1,35,0) "BLD",8863,1,36,0) "BLD",8863,1,37,0) "BLD",8863,1,38,0) "BLD",8863,1,39,0) "BLD",8863,1,40,0) "BLD",8863,1,41,0) "BLD",8863,1,42,0) "BLD",8863,1,43,0) "BLD",8863,1,44,0) *** "BLD",8863,1,45,0) "BLD",8863,1,46,0) This KIDS package comprises the VistA side of the ISI Data Loader 1.0 "BLD",8863,1,47,0) application. The ISI Importer application should ONLY be used for "BLD",8863,1,48,0) training and demonstration purposes. It is NOT intended for any use in a "BLD",8863,1,49,0) clinical or production environment. It was NOT designed, coded, or "BLD",8863,1,50,0) tested for use in a clinical or production environment. "BLD",8863,4,0) ^9.64PA^9001^1 "BLD",8863,4,9001,0) 9001 "BLD",8863,4,9001,222) y^y^f^^n^^y^o^n "BLD",8863,4,"B",9001,9001) "BLD",8863,6.3) 58 "BLD",8863,"KRN",0) ^9.67PA^779.2^20 "BLD",8863,"KRN",.4,0) .4 "BLD",8863,"KRN",.401,0) .401 "BLD",8863,"KRN",.402,0) .402 "BLD",8863,"KRN",.403,0) .403 "BLD",8863,"KRN",.5,0) .5 "BLD",8863,"KRN",.84,0) .84 "BLD",8863,"KRN",3.6,0) 3.6 "BLD",8863,"KRN",3.8,0) 3.8 "BLD",8863,"KRN",9.2,0) 9.2 "BLD",8863,"KRN",9.8,0) 9.8 "BLD",8863,"KRN",9.8,"NM",0) ^9.68A^61^57 "BLD",8863,"KRN",9.8,"NM",1,0) ISIIMP^^0^B24529 "BLD",8863,"KRN",9.8,"NM",2,0) ISIIMP02^^0^B376381 "BLD",8863,"KRN",9.8,"NM",3,0) ISIIMP03^^0^B613740 "BLD",8863,"KRN",9.8,"NM",4,0) ISIIMP04^^0^B403303 "BLD",8863,"KRN",9.8,"NM",5,0) ISIIMP05^^0^B830078 "BLD",8863,"KRN",9.8,"NM",6,0) ISIIMPR1^^0^B3704 "BLD",8863,"KRN",9.8,"NM",8,0) ISIIMPU1^^0^B153268143 "BLD",8863,"KRN",9.8,"NM",9,0) ISIIMPU2^^0^B22535078 "BLD",8863,"KRN",9.8,"NM",10,0) ISIIMPU3^^0^B3746 "BLD",8863,"KRN",9.8,"NM",11,0) ISIIMP06^^0^B622120 "BLD",8863,"KRN",9.8,"NM",12,0) ISIIMP07^^0^B500555 "BLD",8863,"KRN",9.8,"NM",13,0) ISIIMPU4^^0^B9270161 "BLD",8863,"KRN",9.8,"NM",14,0) ISIIMPU5^^0^B1460844 "BLD",8863,"KRN",9.8,"NM",15,0) ISIIMPU6^^0^B1792897 "BLD",8863,"KRN",9.8,"NM",16,0) ISIIMPR2^^0^B3180 "BLD",8863,"KRN",9.8,"NM",17,0) ISIIMP09^^0^B368521 "BLD",8863,"KRN",9.8,"NM",18,0) ISIIMP10^^0^B366470 "BLD",8863,"KRN",9.8,"NM",19,0) ISIIMP11^^0^B396503 "BLD",8863,"KRN",9.8,"NM",20,0) ISIIMP08^^0^B366185 "BLD",8863,"KRN",9.8,"NM",21,0) ISIIMP12^^0^B357413 "BLD",8863,"KRN",9.8,"NM",22,0) ISIIMP13^^0^B1361576 "BLD",8863,"KRN",9.8,"NM",23,0) ISIIMPU7^^0^B1378159 "BLD",8863,"KRN",9.8,"NM",24,0) ISIIMPU8^^0^B1524944 "BLD",8863,"KRN",9.8,"NM",25,0) ISIIMPU9^^0^B2512718 "BLD",8863,"KRN",9.8,"NM",29,0) ISIIMP14^^0^B367014 "BLD",8863,"KRN",9.8,"NM",30,0) ISIIMP15^^0^B977286 "BLD",8863,"KRN",9.8,"NM",31,0) ISIIMP16^^0^B364510 "BLD",8863,"KRN",9.8,"NM",32,0) ISIIMP17^^0^B1304142 "BLD",8863,"KRN",9.8,"NM",33,0) ISIIMPL1^^0^B19810262 "BLD",8863,"KRN",9.8,"NM",34,0) ISIIMPL2^^0^B18734993 "BLD",8863,"KRN",9.8,"NM",35,0) ISIIMPL3^^0^B3141 "BLD",8863,"KRN",9.8,"NM",36,0) ISIIMPL4^^0^B3150 "BLD",8863,"KRN",9.8,"NM",37,0) ISIIMPUA^^0^B4098 "BLD",8863,"KRN",9.8,"NM",38,0) ISIIMPUB^^0^B1561092 "BLD",8863,"KRN",9.8,"NM",39,0) ISIIMP18^^0^B956410 "BLD",8863,"KRN",9.8,"NM",40,0) ISIIMP19^^0^B1482968 "BLD",8863,"KRN",9.8,"NM",41,0) ISIIMPUC^^0^B3534837 "BLD",8863,"KRN",9.8,"NM",42,0) ISIIMP20^^0^B954833 "BLD",8863,"KRN",9.8,"NM",43,0) ISIIMP21^^0^B1438824 "BLD",8863,"KRN",9.8,"NM",44,0) ISIIMPUD^^0^B129421263 "BLD",8863,"KRN",9.8,"NM",45,0) ISIIMP22^^0^B1145057 "BLD",8863,"KRN",9.8,"NM",46,0) ISIIMP23^^0^B33427546 "BLD",8863,"KRN",9.8,"NM",47,0) ISIIMPER^^0^B219589 "BLD",8863,"KRN",9.8,"NM",48,0) ISIIMP24^^0^B289695 "BLD",8863,"KRN",9.8,"NM",49,0) ISIIMP25^^0^B3484 "BLD",8863,"KRN",9.8,"NM",50,0) ISIIMP26^^0^B39578448 "BLD",8863,"KRN",9.8,"NM",51,0) ISIIMP27^^0^B3615 "BLD",8863,"KRN",9.8,"NM",52,0) ISIIMPL5^^0^B31496059 "BLD",8863,"KRN",9.8,"NM",53,0) ISIIMPL6^^0^B7936504 "BLD",8863,"KRN",9.8,"NM",54,0) ISIIMPL7^^0^B51775765 "BLD",8863,"KRN",9.8,"NM",55,0) ISIIMPL8^^0^B84134788 "BLD",8863,"KRN",9.8,"NM",56,0) ISIIMPL9^^0^B80411385 "BLD",8863,"KRN",9.8,"NM",57,0) ISIIMPR3^^0^B3189 "BLD",8863,"KRN",9.8,"NM",58,0) ISIIMPT1^^0^B54209129 "BLD",8863,"KRN",9.8,"NM",59,0) ISIIMPUE^^0^B5663049 "BLD",8863,"KRN",9.8,"NM",60,0) ISIIMPUF^^0^B9623373 "BLD",8863,"KRN",9.8,"NM",61,0) ISIIMPUG^^0^B5155618 "BLD",8863,"KRN",9.8,"NM","B","ISIIMP",1) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP02",2) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP03",3) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP04",4) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP05",5) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP06",11) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP07",12) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP08",20) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP09",17) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP10",18) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP11",19) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP12",21) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP13",22) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP14",29) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP15",30) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP16",31) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP17",32) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP18",39) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP19",40) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP20",42) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP21",43) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP22",45) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP23",46) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP24",48) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP25",49) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP26",50) "BLD",8863,"KRN",9.8,"NM","B","ISIIMP27",51) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPER",47) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL1",33) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL2",34) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL3",35) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL4",36) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL5",52) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL6",53) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL7",54) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL8",55) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPL9",56) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPR1",6) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPR2",16) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPR3",57) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPT1",58) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU1",8) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU2",9) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU3",10) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU4",13) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU5",14) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU6",15) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU7",23) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU8",24) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPU9",25) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPUA",37) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPUB",38) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPUC",41) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPUD",44) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPUE",59) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPUF",60) "BLD",8863,"KRN",9.8,"NM","B","ISIIMPUG",61) "BLD",8863,"KRN",19,0) 19 "BLD",8863,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",8863,"KRN",19,"NM",1,0) ISI DATA IMPORT^^0 "BLD",8863,"KRN",19,"NM","B","ISI DATA IMPORT",1) "BLD",8863,"KRN",19.1,0) 19.1 "BLD",8863,"KRN",101,0) 101 "BLD",8863,"KRN",409.61,0) 409.61 "BLD",8863,"KRN",771,0) 771 "BLD",8863,"KRN",779.2,0) 779.2 "BLD",8863,"KRN",870,0) 870 "BLD",8863,"KRN",8989.51,0) 8989.51 "BLD",8863,"KRN",8989.52,0) 8989.52 "BLD",8863,"KRN",8994,0) 8994 "BLD",8863,"KRN",8994,"NM",0) ^9.68A^23^23 "BLD",8863,"KRN",8994,"NM",1,0) ISI IMPORT APPT^^0 "BLD",8863,"KRN",8994,"NM",2,0) ISI IMPORT PAT^^0 "BLD",8863,"KRN",8994,"NM",3,0) ISI IMPORT PROB^^0 "BLD",8863,"KRN",8994,"NM",4,0) ISI IMPORT VITALS^^0 "BLD",8863,"KRN",8994,"NM",5,0) ISI IMPORT ALLERGY^^0 "BLD",8863,"KRN",8994,"NM",6,0) ISI IMPORT LAB^^0 "BLD",8863,"KRN",8994,"NM",7,0) ISI IMPORT MED^^0 "BLD",8863,"KRN",8994,"NM",8,0) ISI IMPORT NOTE^^0 "BLD",8863,"KRN",8994,"NM",9,0) ISI IMPORT CONSULT^^0 "BLD",8863,"KRN",8994,"NM",10,0) ISI IMPORT TABLEFETCH^^0 "BLD",8863,"KRN",8994,"NM",11,0) ISI IMPORT RAD ORDER^^0 "BLD",8863,"KRN",8994,"NM",12,0) ISI IMPORT ICDFIND^^0 "BLD",8863,"KRN",8994,"NM",13,0) ISI IMPORT GET TEMPLATES^^0 "BLD",8863,"KRN",8994,"NM",14,0) ISI IMPORT USER^^0 "BLD",8863,"KRN",8994,"NM",15,0) ISI IMPORT ADMIT^^0 "BLD",8863,"KRN",8994,"NM",16,0) ISI IMPORT GET TEMPLATE DETLS^^0 "BLD",8863,"KRN",8994,"NM",17,0) ISI IMPORT HFACTOR^^0 "BLD",8863,"KRN",8994,"NM",18,0) ISI IMPORT V CPT^^0 "BLD",8863,"KRN",8994,"NM",19,0) ISI IMPORT IMMUNIZATIONS^^0 "BLD",8863,"KRN",8994,"NM",20,0) ISI IMPORT V PATIENT ED^^0 "BLD",8863,"KRN",8994,"NM",21,0) ISI IMPORT V POV^^0 "BLD",8863,"KRN",8994,"NM",22,0) ISI IMPORT V EXAM^^0 "BLD",8863,"KRN",8994,"NM",23,0) ISI IMPORT SAVE TEMPLATE^^0 "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT ADMIT",15) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT ALLERGY",5) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT APPT",1) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT CONSULT",9) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT GET TEMPLATE DETLS",16) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT GET TEMPLATES",13) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT HFACTOR",17) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT ICDFIND",12) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT IMMUNIZATIONS",19) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT LAB",6) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT MED",7) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT NOTE",8) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT PAT",2) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT PROB",3) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT RAD ORDER",11) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT SAVE TEMPLATE",23) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT TABLEFETCH",10) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT USER",14) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT V CPT",18) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT V EXAM",22) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT V PATIENT ED",20) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT V POV",21) "BLD",8863,"KRN",8994,"NM","B","ISI IMPORT VITALS",4) "BLD",8863,"KRN","B",.4,.4) "BLD",8863,"KRN","B",.401,.401) "BLD",8863,"KRN","B",.402,.402) "BLD",8863,"KRN","B",.403,.403) "BLD",8863,"KRN","B",.5,.5) "BLD",8863,"KRN","B",.84,.84) "BLD",8863,"KRN","B",3.6,3.6) "BLD",8863,"KRN","B",3.8,3.8) "BLD",8863,"KRN","B",9.2,9.2) "BLD",8863,"KRN","B",9.8,9.8) "BLD",8863,"KRN","B",19,19) "BLD",8863,"KRN","B",19.1,19.1) "BLD",8863,"KRN","B",101,101) "BLD",8863,"KRN","B",409.61,409.61) "BLD",8863,"KRN","B",771,771) "BLD",8863,"KRN","B",779.2,779.2) "BLD",8863,"KRN","B",870,870) "BLD",8863,"KRN","B",8989.51,8989.51) "BLD",8863,"KRN","B",8989.52,8989.52) "BLD",8863,"KRN","B",8994,8994) "BLD",8863,"QUES",0) ^9.62^^ "BLD",8863,"REQB",0) ^9.611^^ "DATA",9001,1,0) DEFAULT^13^*,PATIENT^N^666^^2290101^3120524^^99999^999^^^N^^1019^HOSPITAL.NET^*,ZZUSERTEST^11^1^1. "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,14129,-1) 0^1 "KRN",19,14129,0) ISI DATA IMPORT^ISI DATA IMPORT^^B^^^^^^^^ "KRN",19,14129,1,0) ^19.06^1^1^3141107^^^^ "KRN",19,14129,1,1,0) All ISI IMPORT RPC's "KRN",19,14129,99.1) 63348,52721 "KRN",19,14129,"RPC",0) ^19.05P^28^28 "KRN",19,14129,"RPC",1,0) ISI IMPORT APPT "KRN",19,14129,"RPC",2,0) ISI IMPORT LAB "KRN",19,14129,"RPC",3,0) ISI IMPORT MED "KRN",19,14129,"RPC",4,0) ISI IMPORT ALLERGY "KRN",19,14129,"RPC",5,0) ISI IMPORT NOTE "KRN",19,14129,"RPC",6,0) ISI IMPORT PAT "KRN",19,14129,"RPC",7,0) ISI IMPORT PROB "KRN",19,14129,"RPC",8,0) ISI IMPORT VITALS "KRN",19,14129,"RPC",9,0) ISI IMPORT CONSULT "KRN",19,14129,"RPC",10,0) ISI IMPORT RAD ORDER "KRN",19,14129,"RPC",11,0) ISI IMPORT ICDFIND "KRN",19,14129,"RPC",12,0) ISI IMPORT TABLEFETCH "KRN",19,14129,"RPC",13,0) ISI IMPORT ADMIT "KRN",19,14129,"RPC",14,0) ISI IMPORT GET TEMPLATE DETLS "KRN",19,14129,"RPC",15,0) ISI IMPORT GET TEMPLATES "KRN",19,14129,"RPC",16,0) ISI IMPORT HFACTOR "KRN",19,14129,"RPC",17,0) ISI IMPORT V CPT "KRN",19,14129,"RPC",18,0) ISI IMPORT IMMUNIZATIONS "KRN",19,14129,"RPC",19,0) ISI IMPORT V EXAM "KRN",19,14129,"RPC",20,0) ISI IMPORT V PATIENT ED "KRN",19,14129,"RPC",21,0) ISI IMPORT V POV "KRN",19,14129,"RPC",22,0) RAMAG EXAM ORDER "KRN",19,14129,"RPC",23,0) RAMAG EXAMINED "KRN",19,14129,"RPC",24,0) RAMAG EXAM COMPLETE "KRN",19,14129,"RPC",25,0) ORWU DT "KRN",19,14129,"RPC",26,0) ISI IMPORT USER "KRN",19,14129,"RPC",27,0) ORWPT FULLSSN "KRN",19,14129,"RPC",28,0) ISI IMPORT SAVE TEMPLATE "KRN",19,14129,"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. "KRN",8994,2972,-1) 0^13 "KRN",8994,2972,0) ISI IMPORT GET TEMPLATES^TEMPLATE^ISIIMPUA^2^P "KRN",8994,2972,1,0) ^8994.01^1^1^3140522^^ "KRN",8994,2972,1,1,0) Returns list of Import Templates (#9001). "KRN",8994,2972,3,0) ^8994.03^1^1^3140522^^ "KRN",8994,2972,3,1,0) Returns array as OUT(1)=TEMPLATE_IEN^NAME "KRN",8994,2973,-1) 0^16 "KRN",8994,2973,0) ISI IMPORT GET TEMPLATE DETLS^FETCHTMP^ISIIMPUA^2^P "KRN",8994,2973,1,0) ^8994.01^1^1^3140523^^ "KRN",8994,2973,1,1,0) Returns detailed info on #9001 (ISI PT IMPORT TEMPLATE). "KRN",8994,2973,2,0) ^8994.02A^1^1 "KRN",8994,2973,2,1,0) TMPLIEN^1^^1^1 "KRN",8994,2973,2,1,1,0) ^8994.021^1^1^3140523^^ "KRN",8994,2973,2,1,1,1,0) IEN of #9001 (ISI PT IMPORT TEMPLATE). "KRN",8994,2973,2,"B","TMPLIEN",1) "KRN",8994,2973,2,"PARAMSEQ",1,1) "KRN",8994,2973,3,0) ^8994.03^1^1^3140523^^ "KRN",8994,2973,3,1,0) Returns array #9001 field values, using GETS~DIQ(9001,IENS,"*","IE") format. "KRN",8994,2993,-1) 0^14 "KRN",8994,2993,0) ISI IMPORT USER^USRCREAT^ISIIMPR1^2^P^^^1 "KRN",8994,2993,2,0) ^8994.02A^1^1 "KRN",8994,2993,2,1,0) MISC^2^^1^1 "KRN",8994,2993,2,"B","MISC",1) "KRN",8994,2993,2,"PARAMSEQ",1,1) "KRN",8994,2994,-1) 0^15 "KRN",8994,2994,0) ISI IMPORT ADMIT^ADMIT^ISIIMPR3^2^P^^^1 "KRN",8994,2994,1,0) ^8994.01^1^1^3150318^^ "KRN",8994,2994,1,1,0) ISI Dataloader Admission RPC "KRN",8994,2994,2,0) ^8994.02A^1^1 "KRN",8994,2994,2,1,0) MISC^2^^1^1 "KRN",8994,2994,2,"B","MISC",1) "KRN",8994,2994,2,"PARAMSEQ",1,1) "KRN",8994,2995,-1) 0^17 "KRN",8994,2995,0) ISI IMPORT HFACTOR^HFACTOR^ISIIMPR3^2^^^^1 "KRN",8994,2995,1,0) ^8994.01^1^1^3141113^ "KRN",8994,2995,1,1,0) Adds V HEALTH FACTORS "KRN",8994,2995,2,0) ^8994.02A^1^1 "KRN",8994,2995,2,1,0) MISC^2^^1^1 "KRN",8994,2995,2,"B","MISC",1) "KRN",8994,2995,2,"PARAMSEQ",1,1) "KRN",8994,2996,-1) 0^19 "KRN",8994,2996,0) ISI IMPORT IMMUNIZATIONS^VIMMZ^ISIIMPR3^2^P "KRN",8994,2996,2,0) ^8994.02A^1^1 "KRN",8994,2996,2,1,0) MISC^2^^1^1 "KRN",8994,2996,2,"B","MISC",1) "KRN",8994,2996,2,"PARAMSEQ",1,1) "KRN",8994,2997,-1) 0^18 "KRN",8994,2997,0) ISI IMPORT V CPT^VCPT^ISIIMPR3^2^P "KRN",8994,2997,2,0) ^8994.02A^1^1 "KRN",8994,2997,2,1,0) MISC^2^^1^1 "KRN",8994,2997,2,"B","MISC",1) "KRN",8994,2997,2,"PARAMSEQ",1,1) "KRN",8994,2998,-1) 0^22 "KRN",8994,2998,0) ISI IMPORT V EXAM^VEXAM^ISIIMPR3^2^P "KRN",8994,2998,2,0) ^8994.02A^1^1 "KRN",8994,2998,2,1,0) MISC^2^^1^1 "KRN",8994,2998,2,"B","MISC",1) "KRN",8994,2998,2,"PARAMSEQ",1,1) "KRN",8994,2999,-1) 0^21 "KRN",8994,2999,0) ISI IMPORT V POV^VPOV^ISIIMPR3^2^P "KRN",8994,2999,2,0) ^8994.02A^1^1 "KRN",8994,2999,2,1,0) MISC^2^^1^1 "KRN",8994,2999,2,"B","MISC",1) "KRN",8994,2999,2,"PARAMSEQ",1,1) "KRN",8994,3000,-1) 0^20 "KRN",8994,3000,0) ISI IMPORT V PATIENT ED^VPTEDU^ISIIMPR3^2^P "KRN",8994,3000,2,0) ^8994.02A^1^1 "KRN",8994,3000,2,1,0) MISC^2^^1^1 "KRN",8994,3000,2,"B","MISC",1) "KRN",8994,3000,2,"PARAMSEQ",1,1) "KRN",8994,3001,-1) 0^23 "KRN",8994,3001,0) ISI IMPORT SAVE TEMPLATE^TMPUPDTE^ISIIMPR1^2^P^^^1 "KRN",8994,3001,2,0) ^8994.02A^1^1 "KRN",8994,3001,2,1,0) MISC^2^^1^1 "KRN",8994,3001,2,"B","MISC",1) "KRN",8994,3001,2,"PARAMSEQ",1,1) "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") 57 "RTN","ISIIMP") 0^1^B24529 "RTN","ISIIMP",1,0) ISIIMP ;ISI GROUP/MLS -- VistA DATA LOADER 2.0 ;6/26/12 "RTN","ISIIMP",2,0) ;;2.0;;;Jun 26,2012;Build 58 "RTN","ISIIMP",3,0) ; "RTN","ISIIMP",4,0) ; VistA Data Loader 2.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) ; REVISION HISTORY "RTN","ISIIMP",28,0) ; ---------------- "RTN","ISIIMP",29,0) ; V.1.0 JUNE 2012 made possible by JHU, School of Nursing (see above) "RTN","ISIIMP",30,0) ; V.2.0 UPDATE JUNE 2014 made possible by University of Michigan "RTN","ISIIMP",31,0) ; V.2.1 UPDATE NOV 2014 made possible by Oroville Hospital, to support QRDA. "RTN","ISIIMP",32,0) ; V.2.2 Incrimental update: bug fixes, etc. "RTN","ISIIMP",33,0) ; V.2.5 Continued incrimental updates, bug fixes (2015) "RTN","ISIIMP",34,0) ; "RTN","ISIIMP",35,0) ; DECLARATIONS "RTN","ISIIMP",36,0) ; ------------------------------- "RTN","ISIIMP",37,0) ; This software package is NOT for use in any production or clinical setting. "RTN","ISIIMP",38,0) ; The software has not been designed, coded, or tested for use in any clinical "RTN","ISIIMP",39,0) ; or production setting. "RTN","ISIIMP",40,0) ; "RTN","ISIIMP",41,0) ; This should be considered a work in progress. If folks are interested in "RTN","ISIIMP",42,0) ; collaborating on future versions of the utility set should please contact "RTN","ISIIMP",43,0) ; Mike Stark (starklogic@gmail.com) or ISI GROUP, LLC, Bethesda, MD. "RTN","ISIIMP",44,0) ; "RTN","ISIIMP",45,0) ; "RTN","ISIIMP",46,0) ; CREDITS "RTN","ISIIMP",47,0) ; ------------ "RTN","ISIIMP",48,0) ; Some of the utilities used inside this package were first used inside the "RTN","ISIIMP",49,0) ; "CAMP MASTER" VistA training system used at the VA's VEHU conference "RTN","ISIIMP",50,0) ; (available through FOIA). These are not "production" utilities and are "RTN","ISIIMP",51,0) ; not properly attributed to their authors. Most of them were coded by "RTN","ISIIMP",52,0) ; by folks in their spare time out of generosity and dedication to the "RTN","ISIIMP",53,0) ; VA's mission. "RTN","ISIIMP",54,0) ; "RTN","ISIIMP",55,0) ; Where it is not possible to properly give credit, I apologize. Below is a "RTN","ISIIMP",56,0) ; list of routines borrowed from and their author initials. I'm listing them "RTN","ISIIMP",57,0) ; here for proper credit -- all mistakes & bugs are my own (see DECLARATIONS "RTN","ISIIMP",58,0) ; above). "RTN","ISIIMP",59,0) ; "RTN","ISIIMP",60,0) ; LAB utility (LRZORD,LRZORD1,LRZOE,LRZOE2,LRZVER*): DALOI/CJS, NTEO/JFR "RTN","ISIIMP",61,0) ; VITAL utility (ZGMRVPOP): SLC/DAN "RTN","ISIIMP",62,0) ; PATIENT utility (ZVHDPT): DALOI/RM "RTN","ISIIMP",63,0) ; PROBLEM utility (ZVHGMPL): NTEO/JFR "RTN","ISIIMP",64,0) ; APPOINTMENTS utility (ZVHZSDM): SLC/DAN "RTN","ISIIMP",65,0) ; "RTN","ISIIMP",66,0) ; "RTN","ISIIMP",67,0) ; GENERAL OPERATIONS "RTN","ISIIMP",68,0) ; ----------------- "RTN","ISIIMP",69,0) ; 1) Receive input list, MISC, from RPC ^ISIIMPR*. "RTN","ISIIMP",70,0) ; 2) Convert list, MISC, to usable array, ISIMISC, in utility ^ISIIMPU*. "RTN","ISIIMP",71,0) ; 3) Perform validation on array, ISIMISC, in ^ISIIMPU*. "RTN","ISIIMP",72,0) ; 4) Perform import via API in ^ISIIMP##. "RTN","ISIIMP",73,0) ; "RTN","ISIIMP",74,0) ; "RTN","ISIIMP",75,0) ; NAMESPACING -- FUNCTION "RTN","ISIIMP",76,0) ; ------------------------ "RTN","ISIIMP",77,0) ; ISIIMP* -- All DATA Loader routines "RTN","ISIIMP",78,0) ; ISIIMPR* -- RPC entry points "RTN","ISIIMP",79,0) ; ISIIMPU* -- Utilities (merge, validation, etc.) "RTN","ISIIMP",80,0) ; ISIIMP## -- API entry, create, and rpc handlers "RTN","ISIIMP",81,0) ; ISIIMPER -- Error processing "RTN","ISIIMP",82,0) ; ISIIMPL* -- Lab import spill over routines "RTN","ISIIMP",83,0) ; ISIIMPT# -- [some] Unit tests "RTN","ISIIMP",84,0) ; "RTN","ISIIMP",85,0) ; "RTN","ISIIMP",86,0) ; API ENTRY POINT ------ DESCRIPTION "RTN","ISIIMP",87,0) ; ------------------------------------------- "RTN","ISIIMP",88,0) ; IMPORTPT^ISIIMP03 ----- Patient import API "RTN","ISIIMP",89,0) ; APPT^ISIIMP05 ----- Appointment Import API "RTN","ISIIMP",90,0) ; CREATE^ISIIMP07 ----- Problem Import API "RTN","ISIIMP",91,0) ; IMPORTVT^ISIIMP09 ----- Vitals Import API "RTN","ISIIMP",92,0) ; IMPRTALG^ISIIMP11 ----- Allergy Import API "RTN","ISIIMP",93,0) ; IMPRTLAB^ISIIMP13 ----- LABS Import API "RTN","ISIIMP",94,0) ; IMPRTNOT^ISIIMP15 ----- Notes Import API "RTN","ISIIMP",95,0) ; MEDS^ISIIMP17 ----- Med Import API "RTN","ISIIMP",96,0) ; CONS^ISIIMP19 ----- Consults Import API "RTN","ISIIMP",97,0) ; RADO^ISIIMP21 ----- RAD ORDERS Import API "RTN","ISIIMP",98,0) ; USER^ISIIMP22 ----- USER Import API "RTN","ISIIMP",99,0) ; COPYUSR^ISIIMP23 ----- COPY/OVERWRITE USER API "RTN","ISIIMP",100,0) ; COPYPNT^ISIIMP23 ----- COPY Patient data API (*** still in development***) "RTN","ISIIMP",101,0) ; TMPSAVE^ISIIMP24 ----- EDIT TEMPLATE DATA API "RTN","ISIIMP",102,0) ; ADMIT^ISIIMP25 ----- ADMIT API -- DO NOT USE (*** still in development***) "RTN","ISIIMP",103,0) ; DISCHRGE^ISIIMP26 ----- DISCHARGE API -- DO NOT USE (*** still in development***) "RTN","ISIIMP",104,0) ; VEXAM^ISIIMP27 ----- V EXAM entry API "RTN","ISIIMP",105,0) ; VIMMZ^ISIIMP27 ----- V IMMUNIZATION API "RTN","ISIIMP",106,0) ; VCPT^ISIIMP27 ----- V CPT API "RTN","ISIIMP",107,0) ; VHF^ISIIMP27 ----- V HEALTH FACTOR API "RTN","ISIIMP",108,0) ; ENTRY^ISIIMPUA ----- File fetch for external select lists "RTN","ISIIMP",109,0) ; ICD9^ISIIMPUA ----- Fetches ICD description "RTN","ISIIMP",110,0) ; "RTN","ISIIMP",111,0) ; "RTN","ISIIMP",112,0) ; REMOTE PROCEDURE ENTRY POINT DESCRIPTION "RTN","ISIIMP",113,0) ; ------------------------------------------------------------------------------ "RTN","ISIIMP",114,0) ; ISI IMPORT ADMIT ADMIT^ISIIMPR3 Creates Admissions "RTN","ISIIMP",115,0) ; ISI IMPORT ALLERGY ALGMAKE^ISIIMPR2 Load allergy entries "RTN","ISIIMP",116,0) ; ISI IMPORT APPT APPMAKE^ISIIMPR1 Load appt and encounters "RTN","ISIIMP",117,0) ; ISI IMPORT CONSULT CONMAKE^ISIIMPR2 Creates and sign consults "RTN","ISIIMP",118,0) ; ISI IMPORT GET TEMPLATES FETCHTMP^ISIIMPUA Fetch TEMPLATE (#9001) list "RTN","ISIIMP",119,0) ; ISI IMPORT GET TEMPLATE DETLS TEMPLATE^ISIIMPUA Fetches TEMPLATE (#9001) details "RTN","ISIIMP",120,0) ; ISI IMPORT HFACTOR HFACTOR^ISIIMPR3 Creates V HEALTH FACTOR entries "RTN","ISIIMP",121,0) ; ISI IMPORT ICDFIND ICD9GET^ISIIMPR2 Fetches ICD9 Descriptions "RTN","ISIIMP",122,0) ; ISI IMPORT IMMUNIZATIONS VIMMZ^ISIIMPR3 Creates V IMMUNIZATION entries "RTN","ISIIMP",123,0) ; ISI IMPORT LAB LABMAKE^ISIIMPR2 Creates Lab tests "RTN","ISIIMP",124,0) ; ISI IMPORT MED MEDMAKE^ISIIMPR2 Creates Medication orders "RTN","ISIIMP",125,0) ; ISI IMPORT NOTE NOTEMAKE^ISIIMPR2 Creates TIU/Progress note entries "RTN","ISIIMP",126,0) ; ISI IMPORT PAT PNTIMPRT^ISIIMPR1 Creates patient records "RTN","ISIIMP",127,0) ; ISI IMPORT PROB PROBMAKE^ISIIMPR1 Creates Problem entries "RTN","ISIIMP",128,0) ; ISI IMPORT RAD ORDER RADOMAKE^ISIIMPR1 Creates Radiology order entries "RTN","ISIIMP",129,0) ; ISI IMPORT SAVE TEMPLATE TMPUPDTE^ISIIMPR1 Saves Template Updates "RTN","ISIIMP",130,0) ; ISI IMPORT TABLEFETCH TABLEGET^ISIIMPR2 Exports select tables "RTN","ISIIMP",131,0) ; ISI IMPORT USER USRCREAT^ISIIMPR1 Creates User (#200) entries "RTN","ISIIMP",132,0) ; ISI IMPORT V CPT VCPT^ISIIMPR3 Creates V CPT entries "RTN","ISIIMP",133,0) ; ISI IMPORT V EXAM VEXAM^ISIIMPR3 Creates V Exam entries "RTN","ISIIMP",134,0) ; ISI IMPORT V PATIENT ED VPTEDU^ISIIMPR3 Creates V Patient Edu entries "RTN","ISIIMP",135,0) ; ISI IMPORT V POV VPOV^ISIIIMPR3 Creates V POV entries "RTN","ISIIMP",136,0) ; ISI IMPORT VITALS VITMAKE^ISIIMPR1 Creates Vitals entries "RTN","ISIIMP",137,0) ; "RTN","ISIIMP",138,0) ; "RTN","ISIIMP",139,0) ; Validation entry -- Description "RTN","ISIIMP",140,0) ; ----------------------------------- "RTN","ISIIMP",141,0) ; VALIDATE^ISIIMPU1 -- Patient import validation "RTN","ISIIMP",142,0) ; VALAPT^ISIIMPU2 -- Appointment import validation "RTN","ISIIMP",143,0) ; VALPROB^ISIIMPU4 -- Problem import validation "RTN","ISIIMP",144,0) ; VALVITAL^ISIIMPU5 -- Vitals import validation "RTN","ISIIMP",145,0) ; VALALG^ISIIMPU6 -- Allergy import validation "RTN","ISIIMP",146,0) ; VALLAB^ISIIMPU7 -- Labs import validation "RTN","ISIIMP",147,0) ; VALNOTE^ISIIMPU8 -- Notes import validation "RTN","ISIIMP",148,0) ; VALMEDS^ISIIMPU9 -- Meds import validation "RTN","ISIIMP",149,0) ; VALCONS^ISIIMPUB -- Consult import validation "RTN","ISIIMP",150,0) ; VALRADO^ISIIMPUC -- Rad Orders Import validation "RTN","ISIIMP",151,0) ; VALIDATE^ISIIMPUD -- User import validation "RTN","ISIIMP",152,0) ; VALHF^ISIIMPUG -- V Health Factor validation "RTN","ISIIMP",153,0) ; VALIMZ^ISIIMPUG -- V Immunization validation "RTN","ISIIMP",154,0) ; VALCPT^ISIIMPUG -- V CPT validation "RTN","ISIIMP",155,0) ; VALIDATE^ISIIMPUE -- TEMPALATE validation "RTN","ISIIMP",156,0) ; "RTN","ISIIMP",157,0) ; Lab import spill over routines "RTN","ISIIMP",158,0) ; ------------------------------ "RTN","ISIIMP",159,0) ; ISIIMPL1 "RTN","ISIIMP",160,0) ; ISIIMPL2 "RTN","ISIIMP",161,0) ; ISIIMPL3 "RTN","ISIIMP",162,0) ; ISIIMPL4 "RTN","ISIIMP",163,0) ; ISIIMPL5 "RTN","ISIIMP",164,0) ; ISIIMPL6 "RTN","ISIIMP",165,0) ; ISIIMPL7 "RTN","ISIIMP",166,0) ; ISIIMPL8 "RTN","ISIIMP",167,0) ; ISIIMPL9 "RTN","ISIIMP",168,0) ; "RTN","ISIIMP",169,0) ; OPTION "RTN","ISIIMP",170,0) ; --------------------- "RTN","ISIIMP",171,0) ; ISI DATA IMPORT "RTN","ISIIMP",172,0) ; "RTN","ISIIMP",173,0) ; ISI PT IMPORT TEMPLATE (#9001) "RTN","ISIIMP",174,0) ; ------------------------------ "RTN","ISIIMP",175,0) ; 9001,.01 NAME 0;1 FREE TEXT (Required) "RTN","ISIIMP",176,0) ; 9001,1 TYPE 0;2 POINTER TO TYPE OF PATIENT FILE (#391) "RTN","ISIIMP",177,0) ; 9001,2 NAME MASK 0;3 FREE TEXT "RTN","ISIIMP",178,0) ; 9001,4 SSN MASK 0;5 NUMBER "RTN","ISIIMP",179,0) ; 9001,5 SEX 0;6 SET "RTN","ISIIMP",180,0) ; 9001,6 EARLIEST DATE OF BIRTH 0;7 DATE "RTN","ISIIMP",181,0) ; 9001,7 LATEST DATE OF BIRTH 0;8 DATE "RTN","ISIIMP",182,0) ; 9001,8 MARITAL STATUS 0;9 POINTER TO MARITAL STATUS FILE (#11) "RTN","ISIIMP",183,0) ; 9001,9 ZIP+4 MASK 0;10 NUMBER "RTN","ISIIMP",184,0) ; 9001,10 PHONE NUMBER [RESIDENCE] MASK 0;11 NUMBER "RTN","ISIIMP",185,0) ; 9001,11 CITY 0;12 FREE TEXT "RTN","ISIIMP",186,0) ; 9001,12 STATE 0;13 POINTER TO STATE FILE (#5) "RTN","ISIIMP",187,0) ; 9001,13 VETERAN 0;14 SET "RTN","ISIIMP",188,0) ; 9001,14 DFN_NAME 0;4 SET "RTN","ISIIMP",189,0) ; 9001,15 EMPLOYMENT STATUS 0;15 SET "RTN","ISIIMP",190,0) ; 9001,16 SERVICE 0;16 POINTER TO SERVICE/SECTION FILE (#49) "RTN","ISIIMP",191,0) ; 9001,17 EMAIL MASK 0;17 FREE TEXT "RTN","ISIIMP",192,0) ; 9001,18 USER MASK 0;18 FREE TEXT "RTN","ISIIMP",193,0) ; 9001,19 ESIG APPEND 0;19 FREE TEXT "RTN","ISIIMP",194,0) ; 9001,20 ACCESS APPEND 0;20 FREE TEXT "RTN","ISIIMP",195,0) ; 9001,21 VERIFY APPEND 0;21 FREE TEXT "RTN","ISIIMP",196,0) ; "RTN","ISIIMP",197,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 58 "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^B613740 "RTN","ISIIMP03",1,0) ISIIMP03 ;ISI GROUP/MLS -- PATIENT IMPORT CONT. "RTN","ISIIMP03",2,0) ;;1.0;;;Jun 26,2012;Build 58 "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:5 "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,ISINUM,ISIINCR "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,MERGE "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,ISIINCR=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 ISIINCR,I,ISINUM,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,MERGE "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 ISINUM=$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")),ISIINCR) "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=$O(^DG(391,"B","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) S MERGE=$G(ISIMISC("MRG_SOURCE")) "RTN","ISIIMP03",118,0) Q "RTN","ISIIMP03",119,0) CREATEPNT ; "RTN","ISIIMP03",120,0) N FDA,MSG "RTN","ISIIMP03",121,0) K FDA "RTN","ISIIMP03",122,0) D "RTN","ISIIMP03",123,0) . S FDA(2,"+1,",.01)=NAME "RTN","ISIIMP03",124,0) . S FDA(2,"+1,",.02)=SEX "RTN","ISIIMP03",125,0) . S FDA(2,"+1,",.03)=DOB "RTN","ISIIMP03",126,0) . S FDA(2,"+1,",.05)=MARSTAT "RTN","ISIIMP03",127,0) . I $G(OCCUP)'="" S FDA(2,"+1,",.07)=OCCUP "RTN","ISIIMP03",128,0) . S FDA(2,"+1,",.09)=SSN "RTN","ISIIMP03",129,0) . ;S FDA(2,"+1,",400000000)=SSN ;NATIONAL ID field used in EHR "RTN","ISIIMP03",130,0) . S FDA(2,"+1,",.111)=STRT1 "RTN","ISIIMP03",131,0) . S FDA(2,"+1,",.112)=STRT2 "RTN","ISIIMP03",132,0) . S FDA(2,"+1,",.114)=CITY "RTN","ISIIMP03",133,0) . S FDA(2,"+1,",.115)=STATE "RTN","ISIIMP03",134,0) . S FDA(2,"+1,",.1112)=ZIP "RTN","ISIIMP03",135,0) . S FDA(2,"+1,",.131)=PHON "RTN","ISIIMP03",136,0) . S FDA(2,"+1,",391)=TYPE "RTN","ISIIMP03",137,0) . S FDA(2,"+1,",1901)=VETERAN "RTN","ISIIMP03",138,0) . S FDA(2,"+1,",.12105)="N" ; TEMPORARY ADD ACTIVE "RTN","ISIIMP03",139,0) . ;S FDA(2,"+1,",.14105)="N" ; CONFIDENTIAL ADD ACTIVE "RTN","ISIIMP03",140,0) . S FDA(2,"+1,",.2125)="N" ; K-ADD SAME AS PNT'S "RTN","ISIIMP03",141,0) . S FDA(2,"+1,",.21925)="N" ; K2-ADD SAME AS PNT'S "RTN","ISIIMP03",142,0) . S FDA(2,"+1,",.2515)="1" ; SPOUSE EMPLOYMENT STATUS "RTN","ISIIMP03",143,0) . S FDA(2,"+1,",.301)="N" ; SERVICE CONNECTED "RTN","ISIIMP03",144,0) . I $G(EMPLOY)'="" S FDA(2,"+1,",.31115)=EMPLOY "RTN","ISIIMP03",145,0) . E S FDA(2,"+1,",.31115)="1" ; EMPLOYMENT STATUS "RTN","ISIIMP03",146,0) . S FDA(2,"+1,",.3192)="Y" ; COVERED BY HEALTH INSURANCE "RTN","ISIIMP03",147,0) . S FDA(2,"+1,",.32101)="Y" ; VIETNAM SERVICE INDICATED "RTN","ISIIMP03",148,0) . S FDA(2,"+1,",.32102)="N" ; AGENT ORANGE EXPOS. INDICATED "RTN","ISIIMP03",149,0) . S FDA(2,"+1,",.32103)="N" ; RADIATION EXPOSURE INDICATED "RTN","ISIIMP03",150,0) . S FDA(2,"+1,",.32201)="N" ; PERSIAN GULF SERVICE "RTN","ISIIMP03",151,0) . S FDA(2,"+1,",.322013)="N" ; ENVIRONMENTAL CONTAMINANTS "RTN","ISIIMP03",152,0) . S FDA(2,"+1,",.322016)="N" ; SOMALIA SERVICE INDICATED "RTN","ISIIMP03",153,0) . S FDA(2,"+1,",.3221)="N" ; LEBANON SERVICE INDICATED "RTN","ISIIMP03",154,0) . S FDA(2,"+1,",.3224)="N" ; GRENEDA SERVICE INDICATED "RTN","ISIIMP03",155,0) . S FDA(2,"+1,",.3227)="N" ; PANAMA SERVICE INDICATED "RTN","ISIIMP03",156,0) . S FDA(2,"+1,",.3285)="N" ; SERVICE SECOND EPISODE "RTN","ISIIMP03",157,0) . S FDA(2,"+1,",.32945)="N" ; SERVICE THIRD EPISODE "RTN","ISIIMP03",158,0) . S FDA(2,"+1,",.3305)="Y" ; E-EMER. CONTACT SAME AS NOK "RTN","ISIIMP03",159,0) . S FDA(2,"+1,",.3405)="Y" ; D-DESIGNEE SAME AS NOK "RTN","ISIIMP03",160,0) . S FDA(2,"+1,",.362)="0" ; DISABILITY RET. FROM MILITARY "RTN","ISIIMP03",161,0) . S FDA(2,"+1,",.381)="0" ; ELIGIBLE FOR MEDICAID "RTN","ISIIMP03",162,0) . ;S FDA(2,"+1,",.382)="T-"_($R(100)+1) ; DATE MEDICAID LAST ASKED "RTN","ISIIMP03",163,0) . S FDA(2,"+1,",.525)="N" ; POW STATUS INDICATED "RTN","ISIIMP03",164,0) . S FDA(2,"+1,",.5291)="N" ; COMBAT SERVICE INDICATED "RTN","ISIIMP03",165,0) . ;S FDA(2,"+1,",401.4)="T-"_($R(100)+1) ;DATE ENTERED ON SI LIST "RTN","ISIIMP03",166,0) . S FDA(2,"+1,",1010.15)="Y" ; RECIEVED VA CARE PREVIOUSLY "RTN","ISIIMP03",167,0) . S FDA(2,"+1,",994)="N" ; MULTIPLE BIRTH INDICATOR "RTN","ISIIMP03",168,0) . ;S FDA(2.03,"+1,+1,",.01)=$P(DATA,"^",6) "RTN","ISIIMP03",169,0) . I RACE'="" D "RTN","ISIIMP03",170,0) . . S FDA(2.02,"+2,+1,",.01)=RACE "RTN","ISIIMP03",171,0) . . S FDA(2.02,"+2,+1,",.02)="S" "RTN","ISIIMP03",172,0) . I ETHN'="" D "RTN","ISIIMP03",173,0) . . S FDA(2.06,"+3,+1,",.01)=ETHN "RTN","ISIIMP03",174,0) . . S FDA(2.06,"+3,+1,",.02)="S" "RTN","ISIIMP03",175,0) . I INSUR'="" D "RTN","ISIIMP03",176,0) . . S FDA(2.312,"+4,+1,",.01)=INSUR "RTN","ISIIMP03",177,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP03",178,0) . . W !,"+++ FDA Array before patient set +++" "RTN","ISIIMP03",179,0) . . ;ZW FDA "RTN","ISIIMP03",180,0) . . W !,"" R X:5 "RTN","ISIIMP03",181,0) . . Q "RTN","ISIIMP03",182,0) . D UPDATE^DIE("","FDA",,"MSG") "RTN","ISIIMP03",183,0) . I $D(MSG) S ISIRC="-1^"_$G(MSG("DIERR",1,"TEXT",1)) Q "RTN","ISIIMP03",184,0) . ; "RTN","ISIIMP03",185,0) . I '$D(^DPT("SSN",$E(STRTSSN,2,10))) S ISIRC="-1^Problem generating pt." Q "RTN","ISIIMP03",186,0) . I $G(ISIMISC("DFN_NAME"))="Y" I $G(ISIMISC("NAME_MASK"))'="" I $G(ISIMISC("NAME"))="" D "RTN","ISIIMP03",187,0) . . S NAME=$$MASK("NAME",$G(ISIMISC("NAME_MASK")),$O(^DPT("SSN",$E(STRTSSN,2,10),""))) "RTN","ISIIMP03",188,0) . . S ISIRC=$$CHNGNAME^ISIIMPU3($O(^DPT("SSN",$E(STRTSSN,2,10),"")),NAME) "RTN","ISIIMP03",189,0) . . Q "RTN","ISIIMP03",190,0) . I +ISIRC<0 Q "RTN","ISIIMP03",191,0) . S ISIRESUL(ISIINCR)=DFN_"^"_$E(STRTSSN,2,10)_"^"_NAME "RTN","ISIIMP03",192,0) . S ISIRESUL(0)=ISIINCR "RTN","ISIIMP03",193,0) . ;I +$G(MERGE) D COPYPNT^ISIIMP23(MERGE,DFN) ;Copy Patient (not in use) "RTN","ISIIMP03",194,0) . Q "RTN","ISIIMP03",195,0) Q "RTN","ISIIMP03",196,0) ;Q ISIRC "RTN","ISIIMP03",197,0) ; "RTN","ISIIMP03",198,0) MASK(TYPE,VALUE,ISIINCR) "RTN","ISIIMP03",199,0) N X,L,I,CNT,NUMCONV,RETURN "RTN","ISIIMP03",200,0) S RETURN="" "RTN","ISIIMP03",201,0) S TYPE=$G(TYPE),VALUE=$G(VALUE),ISIINCR=$G(ISIINCR) "RTN","ISIIMP03",202,0) ; "RTN","ISIIMP03",203,0) I TYPE="ZIP" D "RTN","ISIIMP03",204,0) . I VALUE="" S VALUE="00000" "RTN","ISIIMP03",205,0) . S I="" F X=$L(VALUE)+1:1:9 S I=I_"9" "RTN","ISIIMP03",206,0) . S L=$L(I),I=$R(I)+1 F X=$L(I)+1:1:L S I="0"_I "RTN","ISIIMP03",207,0) . S RETURN=VALUE_"-"_I "RTN","ISIIMP03",208,0) . Q "RTN","ISIIMP03",209,0) I TYPE="PHONE" D "RTN","ISIIMP03",210,0) . I VALUE="" S VALUE="555555" "RTN","ISIIMP03",211,0) . S I="" F X=$L(VALUE)+1:1:10 S I=I_"9" "RTN","ISIIMP03",212,0) . S L=$L(I),I=$R(I)+1 F X=$L(I)+1:1:L S I="0"_I "RTN","ISIIMP03",213,0) . S RETURN=VALUE_I "RTN","ISIIMP03",214,0) . Q "RTN","ISIIMP03",215,0) I TYPE="NAME" D "RTN","ISIIMP03",216,0) . D NUMTBL "RTN","ISIIMP03",217,0) . S I="" F X=1:1:$L(ISIINCR) S I=I_NUMCONV($E(ISIINCR,X)) "RTN","ISIIMP03",218,0) . S L=I "RTN","ISIIMP03",219,0) . I VALUE="" S VALUE="*,PATIENT" "RTN","ISIIMP03",220,0) . F D Q:VALUE'["*" "RTN","ISIIMP03",221,0) . . F X=1:1:$L(VALUE) I $E(VALUE,X)="*" D Q "RTN","ISIIMP03",222,0) . . . S VALUE=$E(VALUE,0,(X-1))_L_$E(VALUE,(X+1),9999) "RTN","ISIIMP03",223,0) . . . Q "RTN","ISIIMP03",224,0) . . Q "RTN","ISIIMP03",225,0) . S RETURN=VALUE "RTN","ISIIMP03",226,0) . Q "RTN","ISIIMP03",227,0) I TYPE="EMAIL" D "RTN","ISIIMP03",228,0) . N ZNAME,ZEMAIL S ZNAME=$G(NAME) I ZNAME="" S ZNAME="USER,USER" "RTN","ISIIMP03",229,0) . D STDNAME^XLFNAME(.ZNAME,"C") "RTN","ISIIMP03",230,0) . I VALUE="" S VALUE="HOSP.NET" "RTN","ISIIMP03",231,0) . S ZEMAIL=$E(ZNAME("GIVEN"))_"."_ZNAME("FAMILY")_"@"_VALUE "RTN","ISIIMP03",232,0) . S RETURN=ZEMAIL "RTN","ISIIMP03",233,0) . Q "RTN","ISIIMP03",234,0) I $S(TYPE="ELSIG":1,TYPE="ACCESS":1,TYPE="VERIFY":1,1:0),VALUE["*",ISIINCR'="" D "RTN","ISIIMP03",235,0) . F D Q:VALUE'["*" "RTN","ISIIMP03",236,0) . . F X=1:1:$L(VALUE) I $E(VALUE,X)="*" D Q "RTN","ISIIMP03",237,0) . . . S VALUE=$E(VALUE,0,(X-1))_ISIINCR_$E(VALUE,(X+1),9999) "RTN","ISIIMP03",238,0) . . . Q "RTN","ISIIMP03",239,0) . . Q "RTN","ISIIMP03",240,0) . S RETURN=VALUE "RTN","ISIIMP03",241,0) . Q "RTN","ISIIMP03",242,0) ; "RTN","ISIIMP03",243,0) Q RETURN "RTN","ISIIMP03",244,0) ; "RTN","ISIIMP03",245,0) EVALSSNMASK(VALUE) ; "RTN","ISIIMP03",246,0) N I,II,X,CNT "RTN","ISIIMP03",247,0) S I=VALUE F X=$L(VALUE)+1:1:9 S $E(I,X)="0" "RTN","ISIIMP03",248,0) S I="9"_I "RTN","ISIIMP03",249,0) S II=VALUE F X=$L(VALUE)+1:1:9 S $E(II,X)="9" "RTN","ISIIMP03",250,0) S II="9"_II "RTN","ISIIMP03",251,0) S CNT=0 F X=I:1:II I '$D(^DPT("SSN",$E(X,2,10))) S CNT=CNT+1 "RTN","ISIIMP03",252,0) S I=$E(I,2,10),II=$E(II,2,10) "RTN","ISIIMP03",253,0) Q CNT_"|"_I_"|"_II "RTN","ISIIMP03",254,0) ; "RTN","ISIIMP03",255,0) DOB() "RTN","ISIIMP03",256,0) N X,X1,X2,DIFF,TDAY,RESULT "RTN","ISIIMP03",257,0) D NOW^%DTC S TDAY=X "RTN","ISIIMP03",258,0) I $G(LDOB)'="" D "RTN","ISIIMP03",259,0) . D DT^DILF("E",LDOB,.RESULT) "RTN","ISIIMP03",260,0) . S LDOB=RESULT "RTN","ISIIMP03",261,0) I $G(LDOB)="" D ; Generate Lower limit for DOB "RTN","ISIIMP03",262,0) . S X1=TDAY,X2=-(365*90) D C^%DTC S LDOB=X Q "RTN","ISIIMP03",263,0) I $G(HDOB)="" D ; Generate Uppoer limit for DOB "RTN","ISIIMP03",264,0) . S X1=TDAY,X2=-(365*10) D C^%DTC S HDOB=X Q "RTN","ISIIMP03",265,0) ; Gererate random DOB between upper and lower limits "RTN","ISIIMP03",266,0) S X1=HDOB,X2=LDOB D ^%DTC S DIFF=X "RTN","ISIIMP03",267,0) S X1=LDOB S X2=$R(DIFF) D C^%DTC S DOB=X "RTN","ISIIMP03",268,0) Q DOB "RTN","ISIIMP03",269,0) ; "RTN","ISIIMP03",270,0) SEX() "RTN","ISIIMP03",271,0) N Y S Y=$R(2) S SEX=$S(Y=0:"F",1:"M") "RTN","ISIIMP03",272,0) Q SEX "RTN","ISIIMP03",273,0) ; "RTN","ISIIMP03",274,0) CITY() "RTN","ISIIMP03",275,0) N Y K Y "RTN","ISIIMP03",276,0) S Y(1)="ANYTOWN" "RTN","ISIIMP03",277,0) S Y(2)="SMALLVILLE" "RTN","ISIIMP03",278,0) S Y(3)="GOTHAM" "RTN","ISIIMP03",279,0) S Y(4)="CAPITOL CITY" "RTN","ISIIMP03",280,0) S Y(5)="WHOVILLE" "RTN","ISIIMP03",281,0) S Y(6)="METROPOLIS" "RTN","ISIIMP03",282,0) S Y(7)="SPRINGFIELD" "RTN","ISIIMP03",283,0) S Y(8)="ATLANTIS" "RTN","ISIIMP03",284,0) S Y(9)="VILLAGE" "RTN","ISIIMP03",285,0) S Y(10)="EMERALD CITY" "RTN","ISIIMP03",286,0) S Y(11)="CITY ON HILL" "RTN","ISIIMP03",287,0) S Y(12)="SHINING CITY" "RTN","ISIIMP03",288,0) S Y(13)="MOS EISELY" "RTN","ISIIMP03",289,0) S Y(14)="ZION" "RTN","ISIIMP03",290,0) S Y(15)="MAYBERRY" "RTN","ISIIMP03",291,0) S Y(16)="SUNNYDALE" "RTN","ISIIMP03",292,0) S Y(17)="SOUTH PARK" "RTN","ISIIMP03",293,0) S Y(18)="SIN CITY" "RTN","ISIIMP03",294,0) S Y(19)="BEDFORD FALLS" "RTN","ISIIMP03",295,0) S Y(20)="POTTERSVILLE" "RTN","ISIIMP03",296,0) S Y(21)="PLEASANTVILLE" "RTN","ISIIMP03",297,0) S Y(22)="ROCK RIDGE" "RTN","ISIIMP03",298,0) S Y(23)="BRIGADOON" "RTN","ISIIMP03",299,0) S Y=$R(23)+1 S CITY=Y(Y) "RTN","ISIIMP03",300,0) Q CITY "RTN","ISIIMP03",301,0) ; "RTN","ISIIMP03",302,0) STATE() "RTN","ISIIMP03",303,0) N R,Y,EXIT "RTN","ISIIMP03",304,0) S EXIT=0,R=$P(^DIC(5,0),"^",3) "RTN","ISIIMP03",305,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=Y,EXIT=1 "RTN","ISIIMP03",306,0) Q STATE "RTN","ISIIMP03",307,0) ; "RTN","ISIIMP03",308,0) STREET() "RTN","ISIIMP03",309,0) N Y,YY "RTN","ISIIMP03",310,0) S Y(1)="LANE" "RTN","ISIIMP03",311,0) S Y(2)="STREET" "RTN","ISIIMP03",312,0) S Y(3)="ROAD" "RTN","ISIIMP03",313,0) S Y(4)="ALLEY" "RTN","ISIIMP03",314,0) S Y(5)="WAY" "RTN","ISIIMP03",315,0) S Y(6)="DRIVE" "RTN","ISIIMP03",316,0) S Y(7)="AVENUE" "RTN","ISIIMP03",317,0) S Y(8)="PARKWAY" "RTN","ISIIMP03",318,0) S Y(9)="COURT" "RTN","ISIIMP03",319,0) ; "RTN","ISIIMP03",320,0) S YY(1)="FIRST" "RTN","ISIIMP03",321,0) S YY(2)="SECOND" "RTN","ISIIMP03",322,0) S YY(3)="THIRD" "RTN","ISIIMP03",323,0) S YY(4)="FOURTH" "RTN","ISIIMP03",324,0) S YY(5)="FIFTH" "RTN","ISIIMP03",325,0) S YY(6)="SIXTH" "RTN","ISIIMP03",326,0) S YY(7)="SEVENTH" "RTN","ISIIMP03",327,0) S YY(8)="EIGHTH" "RTN","ISIIMP03",328,0) S YY(9)="NINTH" "RTN","ISIIMP03",329,0) ; "RTN","ISIIMP03",330,0) Q $R(1000)+1_" "_YY($R(7)+1)_" "_Y($R(9)+1) "RTN","ISIIMP03",331,0) ; "RTN","ISIIMP03",332,0) MARSTAT() "RTN","ISIIMP03",333,0) N R,Y,EXIT "RTN","ISIIMP03",334,0) S EXIT=0,R=$P(^DIC(11,0),"^",3) "RTN","ISIIMP03",335,0) F Q:EXIT S Y=$R(R)+1 I $P($G(^DIC(11,Y,0)),U)'="" S MARSTAT=Y,EXIT=1 "RTN","ISIIMP03",336,0) Q MARSTAT "RTN","ISIIMP03",337,0) ; "RTN","ISIIMP03",338,0) NUMTBL ; "RTN","ISIIMP03",339,0) S NUMCONV(1)="ONE" "RTN","ISIIMP03",340,0) S NUMCONV(2)="TWO" "RTN","ISIIMP03",341,0) S NUMCONV(3)="THREE" "RTN","ISIIMP03",342,0) S NUMCONV(4)="FOUR" "RTN","ISIIMP03",343,0) S NUMCONV(5)="FIVE" "RTN","ISIIMP03",344,0) S NUMCONV(6)="SIX" "RTN","ISIIMP03",345,0) S NUMCONV(7)="SEVEN" "RTN","ISIIMP03",346,0) S NUMCONV(8)="EIGHT" "RTN","ISIIMP03",347,0) S NUMCONV(9)="NINE" "RTN","ISIIMP03",348,0) S NUMCONV(0)="ZERO" "RTN","ISIIMP03",349,0) Q "RTN","ISIIMP04") 0^4^B403303 "RTN","ISIIMP04",1,0) ISIIMP04 ;ISI GROUP/MLS -- APPT API "RTN","ISIIMP04",2,0) ;;1.0;;;Jun 26,2012;Build 58 "RTN","ISIIMP04",3,0) Q "RTN","ISIIMP04",4,0) APPOINT() ; "RTN","ISIIMP04",5,0) N ERR,VAL,ADATE,SC,DFN,CDATE "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^B830078 "RTN","ISIIMP05",1,0) ISIIMP05 ;ISI Group/MLS -- Appointment Create Utility "RTN","ISIIMP05",2,0) ;;1.0;;;Jun 26,2012;Build 58 "RTN","ISIIMP05",3,0) Q "RTN","ISIIMP05",4,0) ; "RTN","ISIIMP05",5,0) VALIDATE() "RTN","ISIIMP05",6,0) ; "RTN","ISIIMP05",7,0) S ADATE=$G(ISIMISC("ADATE")) "RTN","ISIIMP05",8,0) S SC=$G(ISIMISC("CLIN")) "RTN","ISIIMP05",9,0) S DFN=$G(ISIMISC("PATIENT")) "RTN","ISIIMP05",10,0) I 'DFN S DFN=$G(ISIMISC("PAT_SSN")) "RTN","ISIIMP05",11,0) S CDATE=$G(ISIMISC("CDATE")) ; a bit confusing, need to fix "RTN","ISIIMP05",12,0) ; "RTN","ISIIMP05",13,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP05",14,0) .W !,"ADATE:",$G(ADATE)," SC:",$G(SC)," DFN:",DFN "RTN","ISIIMP05",15,0) .W !,"" R X "RTN","ISIIMP05",16,0) .Q "RTN","ISIIMP05",17,0) ; "RTN","ISIIMP05",18,0) ; Validate import array contents "RTN","ISIIMP05",19,0) S ISIRC=$$VALAPPT^ISIIMPU2 "RTN","ISIIMP05",20,0) Q ISIRC "RTN","ISIIMP05",21,0) ; "RTN","ISIIMP05",22,0) MAKEAPPT() ; "RTN","ISIIMP05",23,0) ; Create Appointment "RTN","ISIIMP05",24,0) S ISIRC=$$APPT(ADATE,SC,DFN,CDATE) "RTN","ISIIMP05",25,0) Q ISIRC "RTN","ISIIMP05",26,0) ; "RTN","ISIIMP05",27,0) APPT(ADATE,SC,DFN,CDATE) "RTN","ISIIMP05",28,0) ; Input - ADATE (Appointment Date [internal fileman format]) "RTN","ISIIMP05",29,0) ; SC (Hospital Location #44) "RTN","ISIIMP05",30,0) ; DFN (Patient DFN #2) "RTN","ISIIMP05",31,0) ; "RTN","ISIIMP05",32,0) ; Output - ISIRC [return code] "RTN","ISIIMP05",33,0) ; "RTN","ISIIMP05",34,0) N COLLAT,SDY,COV,SDYC,OEPTR,ISIVIEN "RTN","ISIIMP05",35,0) S ADATE=$G(ADATE),SC=$G(SC),DFN=$G(DFN),CDATE=$G(CDATE) "RTN","ISIIMP05",36,0) ; "RTN","ISIIMP05",37,0) I $D(^DPT(DFN,"S",ADATE,0)),$P($G(^DPT(DFN,"S",ADATE,0)),U,2)'="C" Q "-9^Duplicate Appointment" "RTN","ISIIMP05",38,0) ; "RTN","ISIIMP05",39,0) S ^DPT(DFN,"S",ADATE,0)=SC "RTN","ISIIMP05",40,0) S ^SC(SC,"S",ADATE,0)=ADATE "RTN","ISIIMP05",41,0) S:'$D(^DPT(DFN,"S",0)) ^(0)="^2.98P^^" "RTN","ISIIMP05",42,0) S:'$D(^SC(SC,"S",0)) ^(0)="^44.001DA^^" "RTN","ISIIMP05",43,0) ; "RTN","ISIIMP05",44,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",45,0) S COLLAT=0,COV=3,SDYC="",COV=$S(COLLAT=1:1,1:3),SDYC=$S(COLLAT=7:1,1:"") "RTN","ISIIMP05",46,0) S:ADATE
0 S ISIVIEN=+VSIT("IEN") "RTN","ISIIMP05",100,0) S ISIMISC("VISIT_IEN")=ISIVIEN "RTN","ISIIMP05",101,0) Q ISIVIEN "RTN","ISIIMP05",102,0) ; "RTN","ISIIMP05",103,0) CHKVST() ;Chec for duplicate entries "RTN","ISIIMP05",104,0) N ZRDATE,VIEN,VDATE S (VIEN,VDATE)=0 "RTN","ISIIMP05",105,0) S ZRDATE=9999999-$P(ADATE,".")_"."_$P(ADATE,".",2) "RTN","ISIIMP05",106,0) F S VIEN=$O(^AUPNVSIT("AA",DFN,ZRDATE,VIEN)) Q:'VIEN!VDATE D "RTN","ISIIMP05",107,0) . I SC'=$P($G(^AUPNVSIT(VIEN,0)),U,22) Q "RTN","ISIIMP05",108,0) . S VDATE=VIEN "RTN","ISIIMP05",109,0) . Q "RTN","ISIIMP05",110,0) Q VDATE "RTN","ISIIMP05",111,0) ; "RTN","ISIIMP05",112,0) ENCOUNTER ; "RTN","ISIIMP05",113,0) N DIE,FDA,MSG "RTN","ISIIMP05",114,0) I '$D(^SCE(0)) S ISIRC="-1^VistA Error. No top level node for OUTPATIENT ENCOUNTER (SCE(0))" Q "RTN","ISIIMP05",115,0) S OEPTR=$P($G(^SCE(0)),U,3) "RTN","ISIIMP05",116,0) K DIE,FDA,MSG "RTN","ISIIMP05",117,0) S FDA(409.68,"+1,",.01)=ADATE "RTN","ISIIMP05",118,0) S FDA(409.68,"+1,",.02)=DFN "RTN","ISIIMP05",119,0) S FDA(409.68,"+1,",.03)=$P($G(^SC(SC,0)),U,7) "RTN","ISIIMP05",120,0) S FDA(409.68,"+1,",.05)=ISIVIEN "RTN","ISIIMP05",121,0) S FDA(409.68,"+1,",.04)=SC "RTN","ISIIMP05",122,0) S FDA(409.68,"+1,",.07)=CDATE "RTN","ISIIMP05",123,0) S FDA(409.68,"+1,",.08)=1 "RTN","ISIIMP05",124,0) S FDA(409.68,"+1,",.09)=SDY "RTN","ISIIMP05",125,0) S FDA(409.68,"+1,",.1)=9 "RTN","ISIIMP05",126,0) S FDA(409.68,"+1,",.11)=$S($P(^SC(SC,0),U,15):$P(^(0),"^",15),1:+$O(^DG(40.8,0))) "RTN","ISIIMP05",127,0) D UPDATE^DIE("","FDA","","MSG") "RTN","ISIIMP05",128,0) I $D(MSG) S ISIRC="-1^Problem saving Outpatient Encounter information (#409.68) "_$G(MSG("DIERR",1,"TEXT",1)) "RTN","ISIIMP05",129,0) Q:+ISIRC<0 "RTN","ISIIMP05",130,0) I $P($G(^SCE(0)),U,3)'>OEPTR S ISIRC="-1^Problem getting Oupatient Encounter pointer (#409.69" Q "RTN","ISIIMP05",131,0) S OEPTR=$P($G(^SCE(0)),U,3) "RTN","ISIIMP05",132,0) S ISIRC=1 "RTN","ISIIMP05",133,0) Q "RTN","ISIIMP05",134,0) ; "RTN","ISIIMP05",135,0) DIAG(OEPTR,ICD) "RTN","ISIIMP05",136,0) ;DIAGNOSIS (409.43,.01) POINTER TO ICD DIAGNOSIS FILE (#80) "RTN","ISIIMP05",137,0) ;OUTPATIENT ENCOUNTER (409.43,.02) POINTER OUTPATIENT ENCOUNTER FILE (#409.68) "RTN","ISIIMP05",138,0) ;DIAGNOSIS RANKING (409.43,.03) FREE TEXT "RTN","ISIIMP05",139,0) Q "RTN","ISIIMP05",140,0) ; "RTN","ISIIMP05",141,0) PATAPPT ; "RTN","ISIIMP05",142,0) N FDA,MSG,IENS "RTN","ISIIMP05",143,0) K FDA,MSG "RTN","ISIIMP05",144,0) S IENS=ADATE_","_DFN_"," "RTN","ISIIMP05",145,0) S FDA(2.98,IENS,3)="O" ;maybe check status and toggle "RTN","ISIIMP05",146,0) S FDA(2.98,IENS,9)=3 "RTN","ISIIMP05",147,0) S FDA(2.98,IENS,19)=DUZ "RTN","ISIIMP05",148,0) S FDA(2.98,IENS,21)=OEPTR "RTN","ISIIMP05",149,0) S FDA(2.98,IENS,22)=1 "RTN","ISIIMP05",150,0) S FDA(2.98,IENS,25)="O" "RTN","ISIIMP05",151,0) S FDA(2.98,IENS,26)=0 "RTN","ISIIMP05",152,0) D FILE^DIE(,"FDA","MSG") "RTN","ISIIMP05",153,0) I $D(MSG) S ISIRC="-1^Problem saving Appointment info (#2.98) - "_$G(MSG("DIERR",1,"TEXT",1)) "RTN","ISIIMP05",154,0) Q:+ISIRC<0 "RTN","ISIIMP05",155,0) S ISIRC=1 "RTN","ISIIMP05",156,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 58 "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^B500555 "RTN","ISIIMP07",1,0) ISIIMP07 ;ISI Group/MLS -- Problem Create Utility "RTN","ISIIMP07",2,0) ;;1.0;;;Jun 26,2012;Build 58 "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:5 "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) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP07",29,0) . W !,"+++ISIIMP07: Values prior to PROBLEM CREATION+++",! "RTN","ISIIMP07",30,0) . I $D(ISIMISC) W $G(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC("_X_")="_ISIMISC(X) "RTN","ISIIMP07",31,0) . W !,"" R X:5 "RTN","ISIIMP07",32,0) . Q "RTN","ISIIMP07",33,0) ; "RTN","ISIIMP07",34,0) ; Double check to prevent duplicates "RTN","ISIIMP07",35,0) I $$DUPCHECK($G(ISIMISC("ICDIEN")),$G(ISIMISC("DFN")),$G(ISIMISC("ENTERED"))) Q "-9^Duplicate Entry Found: CREATE~ISIIMP07" "RTN","ISIIMP07",36,0) ; "RTN","ISIIMP07",37,0) N GMPDFN,GMPPROV,GMPVAMC,GMPFLD "RTN","ISIIMP07",38,0) K GMPDFN,GMPPROV,GMPVAMC,GMPFLD "RTN","ISIIMP07",39,0) S GMPDFN=ISIMISC("DFN") ; patient dfn "RTN","ISIIMP07",40,0) S GMPPROV=ISIMISC("PROVIDER") ;Provider IEN "RTN","ISIIMP07",41,0) S GMPVAMC=$$KSP^XUPARAM("INST") "RTN","ISIIMP07",42,0) S GMPFLD(".01")=ISIMISC("ICDIEN")_U_ISIMISC("ICD") ;Code IEN ^ ICD "RTN","ISIIMP07",43,0) S GMPFLD(".03")=0 ; "RTN","ISIIMP07",44,0) S GMPFLD(".05")="^"_ISIMISC("EXPNM") ;Expression text "RTN","ISIIMP07",45,0) S GMPFLD(".08")=$G(ISIMISC("ENTERED")) ; DATE ENTERED "RTN","ISIIMP07",46,0) S GMPFLD(".12")=ISIMISC("STATUS") ;Active/Inactive "RTN","ISIIMP07",47,0) S GMPFLD(".13")=ISIMISC("ONSET") ;Onset date "RTN","ISIIMP07",48,0) S GMPFLD("1.01")=ISIMISC("EXPIEN")_"^"_ISIMISC("EXPNM") ;^LEX(757.01 ien,descip "RTN","ISIIMP07",49,0) S GMPFLD("1.02")="P" ;CONDITION (1.01) "RTN","ISIIMP07",50,0) S GMPFLD("1.03")=ISIMISC("PROVIDER") ;Entered by "RTN","ISIIMP07",51,0) S GMPFLD("1.04")=ISIMISC("PROVIDER") ;Recording provider "RTN","ISIIMP07",52,0) S GMPFLD("1.05")=ISIMISC("PROVIDER") ;Responsible provider "RTN","ISIIMP07",53,0) S GMPFLD("1.06")=$S($O(^DIC(49,"B","MEDICINE","")):$O(^DIC(49,"B","MEDICINE","")),1:1) ;SERVICE/SECTION (#49) "RTN","ISIIMP07",54,0) S GMPFLD("1.07")=$G(ISIMISC("RESOLVED")) ; Date resolved "RTN","ISIIMP07",55,0) S GMPFLD("1.08")=$G(ISIMISC("LOCATION")) ; Clinic (#44) "RTN","ISIIMP07",56,0) S GMPFLD("1.09")=$G(ISIMISC("RECORDED")) ;DATE RECORDED "RTN","ISIIMP07",57,0) S GMPFLD("1.1")=0 ;Service Connected "RTN","ISIIMP07",58,0) S GMPFLD("1.11")=0 ;Agent Orange exposure "RTN","ISIIMP07",59,0) S GMPFLD("1.12")=0 ;Ionizing radiation exposure "RTN","ISIIMP07",60,0) S GMPFLD("1.13")=0 ;Persian Gulf exposure "RTN","ISIIMP07",61,0) S GMPFLD("1.14")=ISIMISC("TYPE") ;Accute/Chronic (A,C) "RTN","ISIIMP07",62,0) S GMPFLD("1.15")="" ;Head/neck cancer "RTN","ISIIMP07",63,0) S GMPFLD("1.16")="" ;Military sexual trauma "RTN","ISIIMP07",64,0) S GMPFLD("10",0)=0 ;auto set "" "RTN","ISIIMP07",65,0) I $G(ISIMISC("SNOMED"))'="" D "RTN","ISIIMP07",66,0) . S GMPFLD(80001)=ISIMISC("SNOMED")_U_ISIMISC("SNOMED") "RTN","ISIIMP07",67,0) . N SCTD S SCTD=$$GETDES^LEXTRAN1("SCT",$G(ISIMISC("EXPNM"))) "RTN","ISIIMP07",68,0) . I +SCTD=1 S SCTD=$P(SCTD,U,2),GMPFLD(80002)=SCTD_U_SCTD "RTN","ISIIMP07",69,0) . Q "RTN","ISIIMP07",70,0) D NEW^GMPLSAVE "RTN","ISIIMP07",71,0) I '$D(DA) Q "-1^Error creating problem" "RTN","ISIIMP07",72,0) S ISIRESUL(0)=1 "RTN","ISIIMP07",73,0) S ISIRESUL(1)=DA "RTN","ISIIMP07",74,0) ; "RTN","ISIIMP07",75,0) ; Add support to populate V POV file "RTN","ISIIMP07",76,0) I $G(ISIMISC("VPOV"))="Y" S ISIMISC("PROBIEN")=DA D IVPOV^ISIIMP27(.ISIMISC) "RTN","ISIIMP07",77,0) ; "RTN","ISIIMP07",78,0) Q 1 "RTN","ISIIMP07",79,0) ; "RTN","ISIIMP07",80,0) DUPCHECK(ICDIEN,DFN,RECORDDT) "RTN","ISIIMP07",81,0) ;Checks for (possible) duplicate entries in PROBLEM file "RTN","ISIIMP07",82,0) ; INPUT: "RTN","ISIIMP07",83,0) ; ICDIEN = ICD (#80) ien "RTN","ISIIMP07",84,0) ; DFN = patient DFN "RTN","ISIIMP07",85,0) ; RECORDDT = DATE RECORDED (1.09) Filman format "RTN","ISIIMP07",86,0) ; OUTPUT: "RTN","ISIIMP07",87,0) ; OUT = '1' means duplicate found "RTN","ISIIMP07",88,0) ; "RTN","ISIIMP07",89,0) N OUT S OUT=0 "RTN","ISIIMP07",90,0) S DFN=+$G(DFN) I '$D(^DPT(DFN,0)) Q OUT_U_"Bad DFN" ;can't find patient "RTN","ISIIMP07",91,0) S RECORDDT=+$G(RECORDDT) I 'RECORDDT Q OUT_U_"Bad RECORDDT" ;no valid date "RTN","ISIIMP07",92,0) S ICDIEN=+$G(ICDIEN) I '$D(^ICD9(ICDIEN)) Q OUT_U_"Bad ICDIEN" "RTN","ISIIMP07",93,0) I '$D(^AUPNPROB("AC",DFN)) Q OUT_U_"No PROBLEMS found for DFN:"_$G(DFN) "RTN","ISIIMP07",94,0) I '$D(^AUPNPROB("B",ICDIEN)) Q OUT_U_"No PROBLEMS found for ICD9:"_$G(ICDIEN) "RTN","ISIIMP07",95,0) N PROBIEN S PROBIEN=0 F S PROBIEN=$O(^AUPNPROB("B",ICDIEN,PROBIEN)) Q:'PROBIEN!OUT D "RTN","ISIIMP07",96,0) . I $P($G(^AUPNPROB(PROBIEN,0)),U,12)'="A" Q ;only Active "RTN","ISIIMP07",97,0) . I $P($G(^AUPNPROB(PROBIEN,1)),U,9)=RECORDDT,$P($G(^AUPNPROB(PROBIEN,0)),U,2)=DFN S OUT=PROBIEN Q "RTN","ISIIMP07",98,0) . Q "RTN","ISIIMP07",99,0) Q OUT "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 58 "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 58 "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 58 "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 58 "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 58 "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 58 "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 58 "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 58 "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 58 "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 58 "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=$O(^PS(53,"B","NON-VA","")) ; NON-VA ;RX PATIENT STATUS FILE (#53) "RTN","ISIIMP17",44,0) I 'PNTSTAT S PNTSTAT=$O(^PS(53,"B","OTHER","")) "RTN","ISIIMP17",45,0) S PROV=ISIMISC("PROV") ;NEW PERSON FILE (#200) "RTN","ISIIMP17",46,0) S PSODRUG=ISIMISC("DRUG") ;"" ;POINTER TO DRUG FILE (#50) "RTN","ISIIMP17",47,0) S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3) "RTN","ISIIMP17",48,0) S QTY=ISIMISC("QTY") ;NUMBER ;0;7 NUMBER (Required) "RTN","ISIIMP17",49,0) S DAYSUPLY=ISIMISC("SUPPLY") ;NUMBER ; 0;8 NUMBER (Required) "RTN","ISIIMP17",50,0) S REFIL=ISIMISC("REFILL") ;NUMBER ; 0;9 NUMBER (Required) "RTN","ISIIMP17",51,0) S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS; "RTN","ISIIMP17",52,0) S COPIES=1 ;NUMBER "RTN","ISIIMP17",53,0) S MLWIND="W" ;'M' or 'W' "RTN","ISIIMP17",54,0) S ENTERBY=DUZ ;NEW PERSON FILE (#200) "RTN","ISIIMP17",55,0) S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER "RTN","ISIIMP17",56,0) S PSOSITE=ISIMISC("PSOSITE") ; OUTPATIENT SITE FILE (#59) "RTN","ISIIMP17",57,0) D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required) "RTN","ISIIMP17",58,0) S FILLDT=ISIMISC("DATE") ;DATE "RTN","ISIIMP17",59,0) S ISSDT=FILLDT ;DATE "RTN","ISIIMP17",60,0) S DISPDT=ISSDT ;DATE "RTN","ISIIMP17",61,0) S EXPIRDT=$G(ISIMISC("EXPIRDT")) "RTN","ISIIMP17",62,0) I 'EXPIRDT D "RTN","ISIIMP17",63,0) . S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180 "RTN","ISIIMP17",64,0) . S EXPIRDT=X ; "RTN","ISIIMP17",65,0) . Q "RTN","ISIIMP17",66,0) S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7) "RTN","ISIIMP17",67,0) S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE; "RTN","ISIIMP17",68,0) S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1) "RTN","ISIIMP17",69,0) S LDISPDT=FILLDT ; 3;1 DATE "RTN","ISIIMP17",70,0) S REASON="E" ;Activity log ; SET ([E]dit) "RTN","ISIIMP17",71,0) S INIT=DUZ ;NEW PERSON FILE (#200) "RTN","ISIIMP17",72,0) S COM="Oupatient medication order." ;TEXT "RTN","ISIIMP17",73,0) S SIG=ISIMISC("SIG") ;#51,.01 "RTN","ISIIMP17",74,0) I $$DUPCHECK() S ISIRC="-9^Duplicate MED/Prescription found." "RTN","ISIIMP17",75,0) Q "RTN","ISIIMP17",76,0) ; "RTN","ISIIMP17",77,0) DUPCHECK() "RTN","ISIIMP17",78,0) I '$D(^PSRX("AC",$G(ISSDT))) Q 0 "RTN","ISIIMP17",79,0) N X,EXIT S (X,EXIT)=0 F S X=$O(^PSRX("AC",$G(ISSDT),X)) Q:'X!EXIT D "RTN","ISIIMP17",80,0) . I $P($G(^PSRX(X,0)),U,6)=$G(PSODRUG) S EXIT=X Q "RTN","ISIIMP17",81,0) . Q "RTN","ISIIMP17",82,0) ; "RTN","ISIIMP17",83,0) Q EXIT "RTN","ISIIMP17",84,0) ; "RTN","ISIIMP17",85,0) CREATE "RTN","ISIIMP17",86,0) D AUTO^PSONRXN ;RX auto number "RTN","ISIIMP17",87,0) I $G(PSONEW("RX #"))="" S ISIRC="-1^RX Auto number error." Q "RTN","ISIIMP17",88,0) S RXNUM=PSONEW("RX #") "RTN","ISIIMP17",89,0) ; "RTN","ISIIMP17",90,0) S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 "RTN","ISIIMP17",91,0) I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q ;pointer error "RTN","ISIIMP17",92,0) S $P(^PSRX(0),U,3)=PSOIEN "RTN","ISIIMP17",93,0) ; "RTN","ISIIMP17",94,0) S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required) "RTN","ISIIMP17",95,0) S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required) "RTN","ISIIMP17",96,0) S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2) "RTN","ISIIMP17",97,0) S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53) "RTN","ISIIMP17",98,0) S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200) "RTN","ISIIMP17",99,0) S $P(^PSRX(PSOIEN,0),"^",5)="" ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44) "RTN","ISIIMP17",100,0) S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50) "RTN","ISIIMP17",101,0) S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required) "RTN","ISIIMP17",102,0) S $P(^PSRX(PSOIEN,0),"^",8)=DAYSUPLY ;NUMBER ; 0;8 NUMBER (Required) "RTN","ISIIMP17",103,0) S $P(^PSRX(PSOIEN,0),"^",9)=REFIL ;NUMBER ; 0;9 NUMBER (Required) "RTN","ISIIMP17",104,0) S $P(^PSRX(PSOIEN,0),"^",11)=MLWIND ;'M' or 'W' "RTN","ISIIMP17",105,0) S $P(^PSRX(PSOIEN,0),"^",16)=ENTERBY ;NEW PERSON FILE (#200) "RTN","ISIIMP17",106,0) S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER "RTN","ISIIMP17",107,0) S $P(^PSRX(PSOIEN,0),"^",18)=COPIES ;COPIES "RTN","ISIIMP17",108,0) S $P(^PSRX(PSOIEN,0),"^",19)=ORDCONV ;ORDER CONVERTED 0;19 SET ['1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;] "RTN","ISIIMP17",109,0) ; "RTN","ISIIMP17",110,0) S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required) "RTN","ISIIMP17",111,0) S $P(^PSRX(PSOIEN,2),"^",2)=FILLDT ;FILL DATE "RTN","ISIIMP17",112,0) ;S $P(^PSRX(PSOIEN,2),"^",3)=PHARMACIST ; "" ; PHARMACIST ;2;3 POINTER TO NEW PERSON FILE (#200) "RTN","ISIIMP17",113,0) ;S $P(^PSRX(PSOIEN,2),"^",4)="" ; LOT # 2;4 FREE TEXT "RTN","ISIIMP17",114,0) S $P(^PSRX(PSOIEN,2),"^",5)=DISPDT ; DISPENSED DATE 2;5 DATE (Required) "RTN","ISIIMP17",115,0) S $P(^PSRX(PSOIEN,2),"^",6)=EXPIRDT ;"" ; EXPIRATION DATE "RTN","ISIIMP17",116,0) S $P(^PSRX(PSOIEN,2),"^",9)=PSOSITE ;2;9 POINTER TO OUTPATIENT SITE FILE (#59) "RTN","ISIIMP17",117,0) ; "RTN","ISIIMP17",118,0) S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE 3;1 DATE "RTN","ISIIMP17",119,0) ; "RTN","ISIIMP17",120,0) S ^PSRX(PSOIEN,"A",0)="^52.3DA^1^1" "RTN","ISIIMP17",121,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",1)=LOGDT ;DATE "RTN","ISIIMP17",122,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",2)=REASON ;SET "RTN","ISIIMP17",123,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",3)=INIT ;NEW PERSON FILE (#200) "RTN","ISIIMP17",124,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",4)=0 ;NUMBER - RX REFERENCE "RTN","ISIIMP17",125,0) S $P(^PSRX(PSOIEN,"A",1,0),"^",5)="ISI automated entry." ;TEXT "RTN","ISIIMP17",126,0) ; "RTN","ISIIMP17",127,0) S ^PSRX(PSOIEN,"OR1")=PORDITM ;PHARMACY ORDERABLE ITEM FILE (#50.7) "RTN","ISIIMP17",128,0) ; "RTN","ISIIMP17",129,0) S $P(^PSRX(PSOIEN,"POE"),"^",1)=1 ; POE RX POE;1 SET ['1' FOR YES;] "RTN","ISIIMP17",130,0) ; "RTN","ISIIMP17",131,0) S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required) medication instruction DIC(51) "RTN","ISIIMP17",132,0) S $P(^PSRX(PSOIEN,"SIG"),"^",2)=0 ;OERR SIG (SET: 0 for NO; 1 for YES) "RTN","ISIIMP17",133,0) ; "RTN","ISIIMP17",134,0) S $P(^PSRX(PSOIEN,"STA"),"^",1)=STATUS ;STA;1 SET (Required) ; '0' FOR ACTIVE; "RTN","ISIIMP17",135,0) ; "RTN","ISIIMP17",136,0) ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1) "RTN","ISIIMP17",137,0) S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER "RTN","ISIIMP17",138,0) D OERR,F55,F52,F525 "RTN","ISIIMP17",139,0) Q "RTN","ISIIMP17",140,0) ; "RTN","ISIIMP17",141,0) OERR ;UPDATES OR1 NODE "RTN","ISIIMP17",142,0) ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL "RTN","ISIIMP17",143,0) S $P(^PSRX(PSOIEN,"OR1"),"^",2)="" "RTN","ISIIMP17",144,0) S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W" "RTN","ISIIMP17",145,0) D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO) "RTN","ISIIMP17",146,0) F55 ; - File data into ^PS(55) "RTN","ISIIMP17",147,0) ;S PSODFN=DFN "RTN","ISIIMP17",148,0) S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" "RTN","ISIIMP17",149,0) F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) "RTN","ISIIMP17",150,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",151,0) S ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)="" "RTN","ISIIMP17",152,0) K PSOX1 "RTN","ISIIMP17",153,0) Q "RTN","ISIIMP17",154,0) F52 ;; - Re-indexing file 52 entry "RTN","ISIIMP17",155,0) K DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK "RTN","ISIIMP17",156,0) Q "RTN","ISIIMP17",157,0) ; "RTN","ISIIMP17",158,0) F525 ;UPDATE SUSPENSE FILE "RTN","ISIIMP17",159,0) Q:$G(^PSRX(PSOIEN,"STA"))'=5 "RTN","ISIIMP17",160,0) S DA=PSOIEN,X=PSOIEN,FDT=$P($G(^PSRX(PSOIEN,2)),"^",2),TYPE=$P($G(^PSRX(PSOIEN,0)),"^",11) "RTN","ISIIMP17",161,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",162,0) Q "RTN","ISIIMP17",163,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 58 "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 58 "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 58 "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^B1438824 "RTN","ISIIMP21",1,0) ISIIMP21 ;ISI GROUP/MLS -- RAD ORDERS IMPORT CONT. "RTN","ISIIMP21",2,0) ;;1.0;;;Jun 26,2012;Build 58 "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,RESTATUS "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=$$ORDER() "RTN","ISIIMP21",30,0) I (+ISIRC<0) Q ISIRC "RTN","ISIIMP21",31,0) I $G(RESTATUS)="O" Q "RTN","ISIIMP21",32,0) ; "RTN","ISIIMP21",33,0) S ISIRC=$$REGISTER() "RTN","ISIIMP21",34,0) I (+ISIRC<0) Q ISIRC "RTN","ISIIMP21",35,0) I $G(RESTATUS)="R" Q "RTN","ISIIMP21",36,0) ; "RTN","ISIIMP21",37,0) S ISIRC=$$EXAMINE() "RTN","ISIIMP21",38,0) I (+ISIRC<0) Q ISIRC "RTN","ISIIMP21",39,0) I $G(RESTATUS)="E" Q "RTN","ISIIMP21",40,0) ; "RTN","ISIIMP21",41,0) S ISIRC=$$COMPLETE() "RTN","ISIIMP21",42,0) I (+ISIRC<0) Q ISIRC "RTN","ISIIMP21",43,0) ; "RTN","ISIIMP21",44,0) S ISIRESUL(0)=1 "RTN","ISIIMP21",45,0) S ISIRESUL(1)=RAOIFN "RTN","ISIIMP21",46,0) Q ISIRC "RTN","ISIIMP21",47,0) ; "RTN","ISIIMP21",48,0) PREP() "RTN","ISIIMP21",49,0) ; "RTN","ISIIMP21",50,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP21",51,0) . W !,"+++ PREP^ISIIMP21)+++",! "RTN","ISIIMP21",52,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC("_X_")="_$G(ISIMISC(X)) "RTN","ISIIMP21",53,0) . W !,"" R X:5 "RTN","ISIIMP21",54,0) . Q "RTN","ISIIMP21",55,0) ; "RTN","ISIIMP21",56,0) S RESTATUS=$G(ISIMISC("EXAM_STATUS")) I RESTATUS="" S RESTATUS="O" "RTN","ISIIMP21",57,0) S RADFN=$G(ISIMISC("DFN")) I RADFN="" Q "-1^Missing RADFN (PREP ISIIMP21)." "RTN","ISIIMP21",58,0) S RAPROC=$G(ISIMISC("RAPROC")) I RAPROC="" Q "-1^Missing RAPROC (PREP ISIIMP21)." "RTN","ISIIMP21",59,0) S RAMLC=$G(ISIMISC("MAGLOC")) I RAMLC="" Q "-1^Missing MAGLOC (PREP ISIIMP21)." "RTN","ISIIMP21",60,0) S RADTE=$G(ISIMISC("RADTE")) I RADTE="" Q "-1^Missing RADTE (PREP ISIIMP21)." "RTN","ISIIMP21",61,0) S RACAT=$G(ISIMISC("EXAMCAT")) I RACAT="" Q "-1^Missing EXAMCAT (PREP ISIIMP21)." "RTN","ISIIMP21",62,0) S REQLOC=$G(ISIMISC("REQLOC")) I REQLOC="" Q "-1^Missing REQLOC (PREP ISIIMP21)." "RTN","ISIIMP21",63,0) S REQPHYS=$G(ISIMISC("PROV")) I REQPHYS="" Q "-1^Missing PROV (PREP ISIIMP21)." "RTN","ISIIMP21",64,0) S RAREASON=$G(ISIMISC("REASON")) I RAREASON="" Q "-1^Missing REASON (PREP ISIIMP21)." "RTN","ISIIMP21",65,0) K RAMISC "RTN","ISIIMP21",66,0) S RAMISC("ACLHIST",1)=ISIMISC("HISTORY") I RAMISC("ACLHIST",1)="" Q "-1^Missing HISTORY (PREP ISIIMP21)." "RTN","ISIIMP21",67,0) I $G(RAMISC("PREGNANT"))'="Y" I $P($G(^DPT(RADFN,0)),U,2)="F" S RAMISC("PREGNANT")="N" ; hardcoded "RTN","ISIIMP21",68,0) Q 1 "RTN","ISIIMP21",69,0) ; "RTN","ISIIMP21",70,0) ORDER() "RTN","ISIIMP21",71,0) ; "RTN","ISIIMP21",72,0) S RAOIFN=$$ORDER^RAMAG02(.RAMAG,RADFN,RAMLC,RAPROC,RADTE,RACAT,REQLOC,REQPHYS,RAREASON,.RAMISC) "RTN","ISIIMP21",73,0) I (+RAOIFN<0) Q "-1^Error creating Rad Order (CREATE ISIIMP21): "_RAOIFN "RTN","ISIIMP21",74,0) Q 1 "RTN","ISIIMP21",75,0) ; "RTN","ISIIMP21",76,0) REGISTER() "RTN","ISIIMP21",77,0) ; "RTN","ISIIMP21",78,0) N RAMISC K RAMSIC "RTN","ISIIMP21",79,0) S RACAT="O" "RTN","ISIIMP21",80,0) I '$G(RADFN) S RADFN=$G(ISIMISC("DFN")) I 'RADFN Q "-1^Missing RADFN (REGISTER ISIIMP21)." "RTN","ISIIMP21",81,0) I '$G(RADTE) S RADTE=$G(ISIMISC("RADTE")) I 'RADTE Q "-1^Missing RADTE (REGISTER ISIIMP21)." "RTN","ISIIMP21",82,0) I '$G(RAOIFN) Q "-1^Missing RAORINF (Order IEN) in REGISTER^ISIIMP21" "RTN","ISIIMP21",83,0) N RACAT,ISIBUF,ISIMSG D "RTN","ISIIMP21",84,0) . N IENS751 S IENS751=RAOIFN_"," "RTN","ISIIMP21",85,0) . D GETS^DIQ(75.1,IENS751,".01;4","I","ISIBUF","ISIMSG") "RTN","ISIIMP21",86,0) . I $G(DIERR) S ISIRC="-1^VistA Error, pulling Order information (REGISTER ISIIMP21):"_DIERR Q "RTN","ISIIMP21",87,0) . S RACAT=$G(ISIBUF(75.1,IENS751,4,"I")) "RTN","ISIIMP21",88,0) . ;S RADFN=$G(ISIBUF(75.1,IENS751,.01,"I")) "RTN","ISIIMP21",89,0) . S RACAT=$S($G(RACAT)'="":RACAT,1:"O") "RTN","ISIIMP21",90,0) . Q "RTN","ISIIMP21",91,0) I (+ISIRC<0) Q ISIRC "RTN","ISIIMP21",92,0) S ISIRC=$$RAPTREG^RAMAGU04(RADFN) I (+ISIRC<0) Q ISIRC "RTN","ISIIMP21",93,0) ; "RTN","ISIIMP21",94,0) K RAMISC "RTN","ISIIMP21",95,0) S RAMISC("FLAGS")="D" "RTN","ISIIMP21",96,0) S RAMISC("EXAMCAT")="O" ;Outpatient CATEGORY OF EXAM field (4) of sub-file #70.03 "RTN","ISIIMP21",97,0) S RAMISC("PRINCLIN")=$G(ISIMISC("REQLOC")) ; LOCATION file (#44) "RTN","ISIIMP21",98,0) S RAMISC("CLINHIST",1)=$G(ISIMISC("HISTORY"))_" " "RTN","ISIIMP21",99,0) S RAMISC("SERVICE")=$O(^DIC(49,"B","RADIOLOGY","")) ;IEN of SERVICE/SECTION (#49) "RTN","ISIIMP21",100,0) S RAMISC("RAPROC")=$G(ISIMISC("RAPROC")) "RTN","ISIIMP21",101,0) S RAMISC("MAGLOC")=$G(ISIMISC("MAGLOC")) "RTN","ISIIMP21",102,0) S RADTE=$G(ISIMISC("RADTE")) "RTN","ISIIMP21",103,0) ;S RAMISC("TECH")=$G(ISIMISC("TECH")) ; Technologist "RTN","ISIIMP21",104,0) ;S RAMISC("TECHCOMM")=$G(ISIMISC("TECHCOM")) ; Tech comments Captured." "RTN","ISIIMP21",105,0) ;S RAMISC("PRIMINTSTF")=REQPHYS "RTN","ISIIMP21",106,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP21",107,0) . W !,"+++ REGISTER^ISIIMP21)+++",! "RTN","ISIIMP21",108,0) . I $D(RAMISC) S X="" F S X=$O(RAMISC(X)) Q:X="" W !,"RAMISC("_X_")="_$G(RAMISC(X)) "RTN","ISIIMP21",109,0) . W !,"" R X:5 "RTN","ISIIMP21",110,0) . Q "RTN","ISIIMP21",111,0) N RAMAG,OUT K RAMAG,OUT S ISIRC=$$REGISTER^RAMAG03(.RAMAG,.OUT,RAOIFN,RADTE,.RAMISC) "RTN","ISIIMP21",112,0) I (+ISIRC<0) Q "-1^Order created, but can't register exam (REGISTER ISIIMP21): "_ISIRC "RTN","ISIIMP21",113,0) ; S RADFN=$P(OUT(1),"^",1) "RTN","ISIIMP21",114,0) S RADTI=$P(OUT(1),"^",2) "RTN","ISIIMP21",115,0) S RACNI=$P(OUT(1),"^",3) "RTN","ISIIMP21",116,0) S RACASE=$P(OUT(1),"^",4) "RTN","ISIIMP21",117,0) S ACNUMB=$P(OUT(1),"^",5) "RTN","ISIIMP21",118,0) S RAINTDT=$P(OUT(1),"^",6) "RTN","ISIIMP21",119,0) Q 1 "RTN","ISIIMP21",120,0) ; "RTN","ISIIMP21",121,0) EXAMINE() "RTN","ISIIMP21",122,0) ; "RTN","ISIIMP21",123,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP21",124,0) . W !,"+++ EXAMINE^ISIIMP21)+++",! "RTN","ISIIMP21",125,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC("_X_")="_$G(ISIMISC(X)) "RTN","ISIIMP21",126,0) . W !,"RADFN:",$G(RADFN) "RTN","ISIIMP21",127,0) . W !,"RADTI:",$G(RADTI) "RTN","ISIIMP21",128,0) . W !,"RACNT:",$G(RACNI) "RTN","ISIIMP21",129,0) . W !,"" R X:5 "RTN","ISIIMP21",130,0) . Q "RTN","ISIIMP21",131,0) ; "RTN","ISIIMP21",132,0) I $G(RADFN)="" Q "-1^Trying to set to Examined. Can't locate RADFN." "RTN","ISIIMP21",133,0) I $G(RADTI)="" Q "-1^Trying to set to Examined. Can't locate RADTI." "RTN","ISIIMP21",134,0) I $G(RACNI)="" Q "-1^Trying to set to Examined. Can't locate RACNI." "RTN","ISIIMP21",135,0) I '$D(^DPT(RADFN,0)) Q "-1^Trying to set to Examined. Couldn't locate Patient File (#2)" "RTN","ISIIMP21",136,0) ; "RTN","ISIIMP21",137,0) S RACASE=RADFN_U_RADTI_U_RACNI "RTN","ISIIMP21",138,0) I '$G(ISIMISC("TECH")) Q "-1^Trying to set to Examined. Can't locate Tech." "RTN","ISIIMP21",139,0) S RAMISC("TECH",1)=$G(ISIMISC("TECH")) "RTN","ISIIMP21",140,0) S RAMISC("TECHCOMM")=$G(ISIMISC("TECHCOMM")) "RTN","ISIIMP21",141,0) S ISIRC=$$EXAMINED^RAMAG07("",RACASE,.RAMISC) "RTN","ISIIMP21",142,0) I (+ISIRC<0) S ISIRC="-1^Failed to set Rad exam to Examined: "_ISIRC "RTN","ISIIMP21",143,0) Q 1 "RTN","ISIIMP21",144,0) ; "RTN","ISIIMP21",145,0) COMPLETE() "RTN","ISIIMP21",146,0) ; "RTN","ISIIMP21",147,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP21",148,0) . W !,"+++ COMPLETE^ISIIMP21 (ISIMISC)+++",! "RTN","ISIIMP21",149,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC("_X_")="_$G(ISIMISC(X)) "RTN","ISIIMP21",150,0) . W !,"RADFN:",$G(RADFN) "RTN","ISIIMP21",151,0) . W !,"RADTI:",$G(RADTI) "RTN","ISIIMP21",152,0) . W !,"RACNT:",$G(RACNI) "RTN","ISIIMP21",153,0) . W !,"" R X:5 "RTN","ISIIMP21",154,0) . Q "RTN","ISIIMP21",155,0) S RACASE=RADFN_U_RADTI_U_RACNI "RTN","ISIIMP21",156,0) K RAMISC "RTN","ISIIMP21",157,0) S RAMISC("FLAGS")="F" "RTN","ISIIMP21",158,0) ;S RAMISC("TECH")=$G(ISIMISC("TECH")) "RTN","ISIIMP21",159,0) ;S RAMISC("TECHCOMM")=$G(ISIMISC("TECHCOMM")) "RTN","ISIIMP21",160,0) S RAMISC("REPORT",1)="Electronically signed, 'forced' to complete." "RTN","ISIIMP21",161,0) S RAMISC("RPTDTE")=$P(ISIMISC("RADTE"),".") ;Reported Date field (8) of File #74 "RTN","ISIIMP21",162,0) S RAMISC("RPTSTATUS")="EF" ;electronically filed "RTN","ISIIMP21",163,0) ;S RAMISC("IMPRESSION",1)=$G(ISIMISC("IMPRESSION")) "RTN","ISIIMP21",164,0) ;S RAMISC("CLINHIST",1)=$G(ISIMISC("HISTORY")) "RTN","ISIIMP21",165,0) ;S RAMISC("VERDTE")=$P(RADTE,".",1) "RTN","ISIIMP21",166,0) ;S RAMISC("VERPHYS")=REQPHYS "RTN","ISIIMP21",167,0) ;S RAMISC("PRIMDXCODE")=4 "RTN","ISIIMP21",168,0) ;S RAMISC("ELSIG")="" "RTN","ISIIMP21",169,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP21",170,0) . W !,"+++ COMPLETE^ISIIMP21 (RAMISC)+++",! "RTN","ISIIMP21",171,0) . I $D(RAMISC) S X="" F S X=$O(RAMISC(X)) Q:X="" W !,"RAMISC("_X_")="_$G(RAMISC(X)) "RTN","ISIIMP21",172,0) . W !,"RACASE:",$G(RACASE) "RTN","ISIIMP21",173,0) . W !,"" R X:5 "RTN","ISIIMP21",174,0) . Q "RTN","ISIIMP21",175,0) N RAMAG S ISIRC=$$COMPLETE^RAMAG06(.RAMAG,.RACASE,.RAMISC) "RTN","ISIIMP21",176,0) I (+ISIRC<0) Q "-1^Failed to complete rad exam (ISIIMP21): "_ISIRC "RTN","ISIIMP21",177,0) Q 1 "RTN","ISIIMP22") 0^45^B1145057 "RTN","ISIIMP22",1,0) ISIIMP22 ;ISI GROUP/MLS -- IMPORT USER INFORMATION API "RTN","ISIIMP22",2,0) ;;1.0;;;Jun 26,2012;Build 58 "RTN","ISIIMP22",3,0) Q "RTN","ISIIMP22",4,0) ; "RTN","ISIIMP22",5,0) USER(ISIRESUL,ISIMISC) "RTN","ISIIMP22",6,0) N ERR,VAL "RTN","ISIIMP22",7,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMP22",8,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP22",9,0) ; "RTN","ISIIMP22",10,0) ;Validate setup & parameters "RTN","ISIIMP22",11,0) S ISIRC=$$VALIDATE Q:+ISIRC<0 ISIRC "RTN","ISIIMP22",12,0) ;Create USER record "RTN","ISIIMP22",13,0) S ISIRC=$$CREATEUSR Q:+ISIRC<0 ISIRC "RTN","ISIIMP22",14,0) ; Quit with DFN "RTN","ISIIMP22",15,0) Q ISIRC "RTN","ISIIMP22",16,0) ; "RTN","ISIIMP22",17,0) VALIDATE() ; "RTN","ISIIMP22",18,0) ; "RTN","ISIIMP22",19,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP22",20,0) . W !,"+++Template merged params+++",! "RTN","ISIIMP22",21,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,X," ",$G(ISIMISC(X)) "RTN","ISIIMP22",22,0) . W !,"" R X "RTN","ISIIMP22",23,0) . Q "RTN","ISIIMP22",24,0) ; "RTN","ISIIMP22",25,0) ; Validate import array contents "RTN","ISIIMP22",26,0) S ISIRC=$$VALIDATE^ISIIMPUD(.ISIMISC) "RTN","ISIIMP22",27,0) Q ISIRC "RTN","ISIIMP22",28,0) ; "RTN","ISIIMP22",29,0) CREATEUSR() ; "RTN","ISIIMP22",30,0) ; Create USER(s) "RTN","ISIIMP22",31,0) S ISIRC=$$IMPRTUSR(.ISIMISC) "RTN","ISIIMP22",32,0) Q ISIRC "RTN","ISIIMP22",33,0) ; "RTN","ISIIMP22",34,0) IMPRTUSR(ISIMISC) "RTN","ISIIMP22",35,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP22",36,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP22",37,0) ; eg: ISIMISC("NAME")="FIRST,LAST" "RTN","ISIIMP22",38,0) ; "RTN","ISIIMP22",39,0) ; Output - ISIRC [return code] "RTN","ISIIMP22",40,0) ; ISIRESUL(0) = CNT "RTN","ISIIMP22",41,0) ; ISIRESUL(1) = DFN^SSN^NAME "RTN","ISIIMP22",42,0) ; "RTN","ISIIMP22",43,0) I ISIMISC("IMP_TYPE")="B" D BATCH "RTN","ISIIMP22",44,0) I ISIMISC("IMP_TYPE")="I" D INDIVIDUAL "RTN","ISIIMP22",45,0) Q ISIRC "RTN","ISIIMP22",46,0) ; "RTN","ISIIMP22",47,0) INDIVIDUAL "RTN","ISIIMP22",48,0) N SSN,SSNMASK,RETURN,STRTSSN,ENDSSN,NUM,INCR "RTN","ISIIMP22",49,0) N NAME,INITIAL,SEX,DOB,STRT1,STRT2,CITY,STATE,ZIP,PHON,PHOFFICE "RTN","ISIIMP22",50,0) N SERVICE,EMAIL,USERCLASS,TERMDT,MRGSRC,ZDFN "RTN","ISIIMP22",51,0) N ELSIG,ACCESS,VERIFY,SIGAPND,ACCAPND,VERAPND,GENACVE "RTN","ISIIMP22",52,0) ; "RTN","ISIIMP22",53,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP22",54,0) . W !,"+++Starting Individual USER Create+++",! "RTN","ISIIMP22",55,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,X," ",$G(ISIMISC(X)) "RTN","ISIIMP22",56,0) . W !,"" R X:5 "RTN","ISIIMP22",57,0) . Q "RTN","ISIIMP22",58,0) ; "RTN","ISIIMP22",59,0) S ISIRC=0,INCR=1 "RTN","ISIIMP22",60,0) S SSN=$G(ISIMISC("SSN")) "RTN","ISIIMP22",61,0) I SSN'="" D Q "RTN","ISIIMP22",62,0) . I $D(^VA(200,"SSN",SSN)) S ISIRC="-1^Duplicate SSN" Q "RTN","ISIIMP22",63,0) . S STRTSSN="9"_SSN "RTN","ISIIMP22",64,0) . D PREPVAL I +ISIRC<0 Q "RTN","ISIIMP22",65,0) . D CREATE "RTN","ISIIMP22",66,0) . Q "RTN","ISIIMP22",67,0) I SSN="" D "RTN","ISIIMP22",68,0) . S SSNMASK=$G(ISIMISC("SSN_MASK")) "RTN","ISIIMP22",69,0) . I SSNMASK="" S SSNMASK="000" "RTN","ISIIMP22",70,0) . S RETURN=$$EVALSSNMASK(SSNMASK) "RTN","ISIIMP22",71,0) . I (+RETURN)<1 S SSNMASK="666" S RETURN=$$EVALSSNMASK(SSNMASK) "RTN","ISIIMP22",72,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","ISIIMP22",73,0) . S STRTSSN="9"_$P(RETURN,"|",2),ENDSSN="9"_$P(RETURN,"|",3) "RTN","ISIIMP22",74,0) . F Q:'$D(^VA(200,"SSN",$E(STRTSSN,2,10))) S STRTSSN=STRTSSN+1 "RTN","ISIIMP22",75,0) . I STRTSSN>ENDSSN S ISIRC="-1^Problem generating SSN" Q "RTN","ISIIMP22",76,0) . S SSN=$E(STRTSSN,2,10) "RTN","ISIIMP22",77,0) . D PREPVAL I +ISIRC<0 Q ;in case of error "RTN","ISIIMP22",78,0) . D CREATE "RTN","ISIIMP22",79,0) . I +ISIRC<0 Q "RTN","ISIIMP22",80,0) . ; call copy utility "RTN","ISIIMP22",81,0) . I +$G(MRGSRC) D COPYUSR^ISIIMP23(MRGSRC,ZDFN) ; "RTN","ISIIMP22",82,0) . Q "RTN","ISIIMP22",83,0) Q "RTN","ISIIMP22",84,0) ; "RTN","ISIIMP22",85,0) BATCH ; "RTN","ISIIMP22",86,0) N INCR,I,NUM,RETURN,SSNMASK,SSN,STRTSSN,ENDSSN,EXIT "RTN","ISIIMP22",87,0) N NAME,INITIAL,SEX,DOB,STRT1,STRT2,CITY,STATE,ZIP,PHON,PHOFFICE "RTN","ISIIMP22",88,0) N SERVICE,EMAIL,USERCLASS,TERMDT,MRGSRC,ZDFN "RTN","ISIIMP22",89,0) N ELSIG,ACCESS,VERIFY,SIGAPND,ACCAPND,VERAPND,GENACVE "RTN","ISIIMP22",90,0) ; "RTN","ISIIMP22",91,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP22",92,0) . W !,"+++Starting Batch USER Creation+++",! "RTN","ISIIMP22",93,0) . I $D(ISIMISC) W $G(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,ISIMISC(X) "RTN","ISIIMP22",94,0) . W !,"" R X:5 "RTN","ISIIMP22",95,0) . Q "RTN","ISIIMP22",96,0) ; "RTN","ISIIMP22",97,0) S EXIT=0,ISIRC=0 "RTN","ISIIMP22",98,0) S NUM=$G(ISIMISC("IMP_BATCH_NUM")) "RTN","ISIIMP22",99,0) S SSNMASK=$G(ISIMISC("SSN_MASK")) "RTN","ISIIMP22",100,0) S RETURN=$$EVALSSNMASK(SSNMASK) "RTN","ISIIMP22",101,0) I (+RETURN)ENDSSN S EXIT=1,ISIRC="-1^Problem generating SSNs" Q "RTN","ISIIMP22",106,0) . S SSN=$E(STRTSSN,2,10) "RTN","ISIIMP22",107,0) . D PREPVAL I +ISIRC<0 S EXIT=1 Q "RTN","ISIIMP22",108,0) . D CREATE "RTN","ISIIMP22",109,0) . I +ISIRC<0 S EXIT=1 Q "RTN","ISIIMP22",110,0) . I +$G(MRGSRC) D COPYUSR^ISIIMP23(MRGSRC,ZDFN) "RTN","ISIIMP22",111,0) . Q "RTN","ISIIMP22",112,0) Q "RTN","ISIIMP22",113,0) ; "RTN","ISIIMP22",114,0) PREPVAL ;Prep import values "RTN","ISIIMP22",115,0) N LDOB,UDOB "RTN","ISIIMP22",116,0) S (NAME,SEX,DOB,STRT1,STRT2,CITY,STATE,ZIP,PHON,EMAIL,PHOFFICE,USERCLASS,SERVICE,TERMDT,MRGSRC,INITIAL)="" "RTN","ISIIMP22",117,0) S NAME=$G(ISIMISC("NAME")) I NAME="" S NAME=$$MASK^ISIIMP03("NAME",$G(ISIMISC("NAME_MASK")),INCR) "RTN","ISIIMP22",118,0) D STDNAME^XLFNAME(.NAME,"C") S INITIAL=$E($G(NAME("GIVEN")))_$E($G(NAME("FAMILY"))) "RTN","ISIIMP22",119,0) S SEX=$G(ISIMISC("SEX")) "RTN","ISIIMP22",120,0) I SEX="" S SEX=$$SEX^ISIIMP03 "RTN","ISIIMP22",121,0) S DOB=$G(ISIMISC("DOB")) I DOB="" S LDOB=$G(ISIMISC("LOW_DOB")),UDOB=$G(ISIMISC("UP_DOB")) S DOB=$$DOB^ISIIMP03 "RTN","ISIIMP22",122,0) S STRT1=$G(ISIMISC("STREET_ADD1")) "RTN","ISIIMP22",123,0) I STRT1="" S STRT1=$$STREET^ISIIMP03 "RTN","ISIIMP22",124,0) S STRT2=$G(ISIMISC("STREET_ADD2")) "RTN","ISIIMP22",125,0) S CITY=$G(ISIMISC("CITY")) I CITY="" S CITY=$$CITY^ISIIMP03 "RTN","ISIIMP22",126,0) S STATE=$G(ISIMISC("STATE")) I STATE="" S STATE=$$STATE^ISIIMP03 "RTN","ISIIMP22",127,0) S ZIP=$G(ISIMISC("ZIP")) I ZIP="" S ZIP=$$MASK^ISIIMP03("ZIP",$G(ISIMISC("ZIP_4_MASK"))) "RTN","ISIIMP22",128,0) S PHON=$G(ISIMISC("PH_NUM")) I PHON="" S PHON=$$MASK^ISIIMP03("PHONE",$G(ISIMISC("PH_NUM_MASK"))) "RTN","ISIIMP22",129,0) S EMAIL=$G(ISIMISC("EMAIL")) I EMAIL="" S EMAIL=$$MASK^ISIIMP03("EMAIL",$G(ISIMISC("EMAIL_MASK"))) "RTN","ISIIMP22",130,0) S PHOFFICE=$G(ISIMISC("PH_OFFICE")) I PHOFFICE="" S PHOFFICE=$$MASK^ISIIMP03("PHONE",$G(ISIMISC("PH_NUM_MASK"))) "RTN","ISIIMP22",131,0) S USERCLASS=$G(ISIMISC("USER_CLASS")) "RTN","ISIIMP22",132,0) S SERVICE=$G(ISIMISC("SERVICE")) "RTN","ISIIMP22",133,0) S TERMDT=$G(ISIMISC("TERM_DATE")) "RTN","ISIIMP22",134,0) S MRGSRC=$G(ISIMISC("MRG_SOURCE")) "RTN","ISIIMP22",135,0) S ELSIG=$G(ISIMISC("ELSIG")) "RTN","ISIIMP22",136,0) S ACCESS=$G(ISIMISC("ACCESS")) "RTN","ISIIMP22",137,0) S VERIFY=$G(ISIMISC("VERIFY")) "RTN","ISIIMP22",138,0) S SIGAPND=$G(ISIMISC("ELSIG_APND")) I SIGAPND="" S SIGAPND="11" "RTN","ISIIMP22",139,0) S ACCAPND=$G(ISIMISC("ACCESS_APND")) I ACCAPND="" S ACCAPND="1" "RTN","ISIIMP22",140,0) S VERAPND=$G(ISIMISC("VERIFY_APND")) I VERAPND="" S VERAPND="1." "RTN","ISIIMP22",141,0) S GENACVE=+$G(ISIMISC("GEN_ACCVER")) "RTN","ISIIMP22",142,0) ; "RTN","ISIIMP22",143,0) ; Final check of required values "RTN","ISIIMP22",144,0) ; ------------------------------ "RTN","ISIIMP22",145,0) I $G(NAME)="" S ISIRC="-1^Missing valid NAME value (PREPVAL~ISIIMP22)" Q "RTN","ISIIMP22",146,0) I $L(+$G(SSN))<9 S ISIRC="-1^Missing valid SSN value (PREPVAL~ISIIMP22)" Q "RTN","ISIIMP22",147,0) I $G(SERVICE)=0 S ISIRC="-1^Missing valid SERVICE value (PREPVAL~ISIIMP22)" Q "RTN","ISIIMP22",148,0) Q "RTN","ISIIMP22",149,0) ; "RTN","ISIIMP22",150,0) CREATE ; "RTN","ISIIMP22",151,0) N FDA,MSG "RTN","ISIIMP22",152,0) K FDA,FDAIENS "RTN","ISIIMP22",153,0) S DIC="^VA(200,",DIC(0)="ILMXZ",DLAYGO=200 ;maybe "RTN","ISIIMP22",154,0) D "RTN","ISIIMP22",155,0) . S FDA(200,"+1,",.01)=NAME "RTN","ISIIMP22",156,0) . I $G(INITIAL)'="" S FDA(200,"+1,",1)=INITIAL "RTN","ISIIMP22",157,0) . S FDA(200,"+1,",4)=SEX "RTN","ISIIMP22",158,0) . S FDA(200,"+1,",5)=DOB "RTN","ISIIMP22",159,0) . S FDA(200,"+1,",9)=SSN "RTN","ISIIMP22",160,0) . S FDA(200,"+1,",29)=SERVICE "RTN","ISIIMP22",161,0) . I $G(STRT1)'="" S FDA(200,"+1,",.111)=STRT1 "RTN","ISIIMP22",162,0) . I $G(STRT2)'="" S FDA(200,"+1,",.112)=STRT2 "RTN","ISIIMP22",163,0) . I $G(CITY)'="" S FDA(200,"+1,",.114)=CITY "RTN","ISIIMP22",164,0) . I $G(STATE)'="" S FDA(200,"+1,",.115)=STATE "RTN","ISIIMP22",165,0) . I $G(ZIP)'="" S FDA(200,"+1,",.116)=ZIP "RTN","ISIIMP22",166,0) . I $G(PHON)'="" S FDA(200,"+1,",.131)=PHON ;home phone "RTN","ISIIMP22",167,0) . I $G(PHOFFICE)'="" S FDA(200,"+1,",.132)=PHOFFICE ;office phone "RTN","ISIIMP22",168,0) . I $G(EMAIL)'="" S FDA(200,"+1,",.151)=EMAIL "RTN","ISIIMP22",169,0) . I $G(TERMDT)'="" S FDA(200,"+1,",9.2)=TERMDT "RTN","ISIIMP22",170,0) . ; "RTN","ISIIMP22",171,0) . I USERCLASS'="" D "RTN","ISIIMP22",172,0) . . S FDA(200.07,"+2,+1,",.01)=USERCLASS "RTN","ISIIMP22",173,0) . . S FDA(200.07,"+2,+1,",2)=1 ;Is primary (yes) "RTN","ISIIMP22",174,0) . ; "RTN","ISIIMP22",175,0) . D UPDATE^DIE("E","FDA","FDAIENS","MSG") "RTN","ISIIMP22",176,0) . I $D(MSG) S ISIRC="-1^"_$G(MSG("DIERR",1,"TEXT",1)) Q "RTN","ISIIMP22",177,0) . S ZDFN=+$G(FDAIENS(1)) "RTN","ISIIMP22",178,0) . ; "RTN","ISIIMP22",179,0) . I '$D(^VA(200,"SSN",$E(STRTSSN,2,10))) S ISIRC="-1^Problem generating user (CREATE~ISIIMP22)." Q "RTN","ISIIMP22",180,0) . I $G(ISIMISC("DFN_NAME"))="Y" I $G(ISIMISC("NAME_MASK"))'="" I $G(ISIMISC("NAME"))="" D "RTN","ISIIMP22",181,0) . . S NAME=$$MASK^ISIIMP03("NAME",$G(ISIMISC("NAME_MASK")),$O(^VA(200,"SSN",$E(STRTSSN,2,10),""))) "RTN","ISIIMP22",182,0) . . S ISIRC=$$CHNGUSER^ISIIMPU3(ZDFN,NAME) "RTN","ISIIMP22",183,0) . . Q "RTN","ISIIMP22",184,0) . ; "RTN","ISIIMP22",185,0) . N ZLNAME S ZLNAME=$P($G(^VA(200,ZDFN,0)),U),ZLNAME=$P(ZLNAME,",")_"*" ; "RTN","ISIIMP22",186,0) . S ELSIG=$G(ELSIG) I ELSIG="" S ELSIG=$$MASK^ISIIMP03("ELSIG",ZLNAME,SIGAPND) "RTN","ISIIMP22",187,0) . D FILESIG "RTN","ISIIMP22",188,0) . S ACCESS=$G(ACCESS) I ACCESS="" S ACCESS=$$MASK^ISIIMP03("ACCESS",ZLNAME,ACCAPND) "RTN","ISIIMP22",189,0) . I $G(GENACVE) D FILEACC "RTN","ISIIMP22",190,0) . S VERIFY=$G(VERIFY) I VERIFY="" S VERIFY=$$MASK^ISIIMP03("VERIFY",ZLNAME,VERAPND) "RTN","ISIIMP22",191,0) . I $G(GENACVE) D FILEVER "RTN","ISIIMP22",192,0) . ; "RTN","ISIIMP22",193,0) . I +ISIRC<0 Q "RTN","ISIIMP22",194,0) . S ISIRESUL(INCR)=ZDFN_"^"_$E(STRTSSN,2,10)_"^"_NAME "RTN","ISIIMP22",195,0) . S ISIRESUL(0)=INCR "RTN","ISIIMP22",196,0) . Q "RTN","ISIIMP22",197,0) Q "RTN","ISIIMP22",198,0) ; "RTN","ISIIMP22",199,0) FILESIG "RTN","ISIIMP22",200,0) N tempFILE,tempFIELD "RTN","ISIIMP22",201,0) K MSG,FDA "RTN","ISIIMP22",202,0) S ELSIG=$G(ELSIG) "RTN","ISIIMP22",203,0) Q:$L(ELSIG)<6 ;mininum 6 chars "RTN","ISIIMP22",204,0) S tempFILE="200" "RTN","ISIIMP22",205,0) S tempFIELD="20.4" "RTN","ISIIMP22",206,0) S FDA(tempFILE,ZDFN_",",tempFIELD)=ELSIG "RTN","ISIIMP22",207,0) D FILE^DIE("E","FDA","MSG") "RTN","ISIIMP22",208,0) I $G(DIERR) S ISIRC="-1^Error "_$G(DIERR)_" filing EL SIG (FILESIG~ISIIMP22) for DFN:"_$G(ZDFN) "RTN","ISIIMP22",209,0) ;ZW DIERR I $D(MSG) W ! ZW MSG "RTN","ISIIMP22",210,0) Q "RTN","ISIIMP22",211,0) ; "RTN","ISIIMP22",212,0) FILEACC ; "RTN","ISIIMP22",213,0) N tempFILE,tempFIELD "RTN","ISIIMP22",214,0) K MSG,FDA "RTN","ISIIMP22",215,0) S tempFILE="200" "RTN","ISIIMP22",216,0) S tempFIELD="2" "RTN","ISIIMP22",217,0) S FDA(tempFILE,ZDFN_",",tempFIELD)=ACCESS "RTN","ISIIMP22",218,0) D FILE^DIE("E","FDA","MSG") "RTN","ISIIMP22",219,0) I $G(DIERR) S ISIRC="-1^Error "_$G(DIERR)_" filing ACCESS CODE (FILEACC~ISIIMP22) for DFN:"_$G(ZDFN) "RTN","ISIIMP22",220,0) Q "RTN","ISIIMP22",221,0) ; "RTN","ISIIMP22",222,0) FILEVER ; "RTN","ISIIMP22",223,0) N tempFILE,tempFIELD "RTN","ISIIMP22",224,0) K MSG,FDA "RTN","ISIIMP22",225,0) S tempFILE="200" "RTN","ISIIMP22",226,0) S tempFIELD="11" "RTN","ISIIMP22",227,0) S FDA(tempFILE,ZDFN_",",tempFIELD)=VERIFY "RTN","ISIIMP22",228,0) D FILE^DIE("E","FDA","MSG") "RTN","ISIIMP22",229,0) I $G(DIERR) S ISIRC="-1^Error "_$G(DIERR)_" filing VERIFY CODE (FILEVER~ISIIMP22) for DFN:"_$G(ZDFN) "RTN","ISIIMP22",230,0) Q "RTN","ISIIMP22",231,0) ; "RTN","ISIIMP22",232,0) EVALSSNMASK(VALUE) ; "RTN","ISIIMP22",233,0) N I,II,X,CNT "RTN","ISIIMP22",234,0) S I=VALUE F X=$L(VALUE)+1:1:9 S $E(I,X)="0" "RTN","ISIIMP22",235,0) S I="9"_I "RTN","ISIIMP22",236,0) S II=VALUE F X=$L(VALUE)+1:1:9 S $E(II,X)="9" "RTN","ISIIMP22",237,0) S II="9"_II "RTN","ISIIMP22",238,0) S CNT=0 F X=I:1:II I '$D(^VA(200,"SSN",$E(X,2,10))) S CNT=CNT+1 "RTN","ISIIMP22",239,0) S I=$E(I,2,10),II=$E(II,2,10) "RTN","ISIIMP22",240,0) Q CNT_"|"_I_"|"_II "RTN","ISIIMP22",241,0) ; "RTN","ISIIMP23") 0^46^B33427546 "RTN","ISIIMP23",1,0) ISIIMP23 ;ISI GROUP/MLS -- Merge Users Utility 2.0 ;6/26/12 "RTN","ISIIMP23",2,0) ;;2.0;;;Jun 26,2012;Build 58 "RTN","ISIIMP23",3,0) ; "RTN","ISIIMP23",4,0) ; NOTE -- This routine should be used with EXTREME caution. "RTN","ISIIMP23",5,0) ; It is ONLY(!!!) for test and demonstration systems. "RTN","ISIIMP23",6,0) Q "RTN","ISIIMP23",7,0) ; "RTN","ISIIMP23",8,0) ; ***************************************************************** "RTN","ISIIMP23",9,0) ; Entry point for Utility to copy User file information "RTN","ISIIMP23",10,0) ; "RTN","ISIIMP23",11,0) ; INPUT: "RTN","ISIIMP23",12,0) ; FPROV = DFN of source NEW PERSON (#200) record "RTN","ISIIMP23",13,0) ; TPROV = DFN of target NEW PERSON (#200) record "RTN","ISIIMP23",14,0) ; "RTN","ISIIMP23",15,0) ;****************************************************************** "RTN","ISIIMP23",16,0) ; "RTN","ISIIMP23",17,0) COPYUSR(FPROV,TPROV) ; "RTN","ISIIMP23",18,0) ; "RTN","ISIIMP23",19,0) N X,Y,Z "RTN","ISIIMP23",20,0) S FPROV=+$G(FPROV) "RTN","ISIIMP23",21,0) S TPROV=+$G(TPROV) "RTN","ISIIMP23",22,0) I '$D(^VA(200,TPROV,0)) Q "RTN","ISIIMP23",23,0) I '$D(^VA(200,FPROV,0)) Q "RTN","ISIIMP23",24,0) I TPROV=1 Q ;Don't overwrite one "RTN","ISIIMP23",25,0) ; "RTN","ISIIMP23",26,0) ; Start "RTN","ISIIMP23",27,0) D BEGIN(FPROV,TPROV) "RTN","ISIIMP23",28,0) D CROSSREF(FPROV,TPROV) "RTN","ISIIMP23",29,0) Q "RTN","ISIIMP23",30,0) ; "RTN","ISIIMP23",31,0) BEGIN(FPROV,TPROV) ; "RTN","ISIIMP23",32,0) ; "RTN","ISIIMP23",33,0) ;Kill "RTN","ISIIMP23",34,0) K ^VA(200,TPROV,.2) ;UCIs (set of uscs user my choose) "RTN","ISIIMP23",35,0) K ^VA(200,TPROV,2) ; Divisions "RTN","ISIIMP23",36,0) K ^VA(200,TPROV,3.1) "RTN","ISIIMP23",37,0) K ^VA(200,TPROV,4) ;Mutually exclusive keys (cannot be held by this user) "RTN","ISIIMP23",38,0) K ^VA(200,TPROV,5) ;Service Section, mail code "RTN","ISIIMP23",39,0) K ^VA(200,TPROV,19.5) ;Delegated options "RTN","ISIIMP23",40,0) K ^VA(200,TPROV,19.6) ; Allowable New Menu "RTN","ISIIMP23",41,0) K ^VA(200,TPROV,19.8) ; Menu template "RTN","ISIIMP23",42,0) K ^VA(200,TPROV,50) ;Key delegation level "RTN","ISIIMP23",43,0) K ^VA(200,TPROV,51) ;keys "RTN","ISIIMP23",44,0) K ^VA(200,TPROV,52) ;Delegated keys "RTN","ISIIMP23",45,0) K ^VA(200,TPROV,101) ;Restrict patient Selection "RTN","ISIIMP23",46,0) K ^VA(200,TPROV,125) ; Problem list Primary view "RTN","ISIIMP23",47,0) K ^VA(200,TPROV,200) ; Multiple Sign-on "RTN","ISIIMP23",48,0) K ^VA(200,TPROV,201) ;Primary Menu option "RTN","ISIIMP23",49,0) K ^VA(200,TPROV,202.1) ;Last option accessed "RTN","ISIIMP23",50,0) K ^VA(200,TPROV,203) ;Secondary Menu option "RTN","ISIIMP23",51,0) K ^VA(200,TPROV,351) ;Personal diagnosis codes "RTN","ISIIMP23",52,0) K ^VA(200,TPROV,500) ;network addresss "RTN","ISIIMP23",53,0) K ^VA(200,TPROV,8910) ;Visited from "RTN","ISIIMP23",54,0) K ^VA(200,TPROV,"FOF") ;Accessible file (#200.032) "RTN","ISIIMP23",55,0) K ^VA(200,TPROV,"EC") ;DMMS Units "RTN","ISIIMP23",56,0) K ^VA(200,TPROV,"LM1") ; Spelling exception "RTN","ISIIMP23",57,0) K ^VA(200,TPROV,"LM2") ; DEFINED FORMATS FOR LM "RTN","ISIIMP23",58,0) K ^VA(200,TPROV,"LM3") ; DEFINED PHRASES FOR LM "RTN","ISIIMP23",59,0) K ^VA(200,TPROV,"LM4") ; LM LIMIT WP FIELDS TO EDIT "RTN","ISIIMP23",60,0) K ^VA(200,TPROV,"ORD") ;CPRS TABs "RTN","ISIIMP23",61,0) K ^VA(200,TPROV,"NPI") "RTN","ISIIMP23",62,0) K ^VA(200,TPROV,"PS") ;authorized to write medicao orders "RTN","ISIIMP23",63,0) K ^VA(200,TPROV,"PS1") ;Licensing State (credentialling) "RTN","ISIIMP23",64,0) K ^VA(200,TPROV,"PS2") ; STATE ISSUING DEA NUMBER "RTN","ISIIMP23",65,0) K ^VA(200,TPROV,"PS3") ; SCHEDULE II NARCOTIC, etc. "RTN","ISIIMP23",66,0) K ^VA(200,TPROV,"RAC") ;Rad/Nun Classification "RTN","ISIIMP23",67,0) K ^VA(200,TPROV,"RAL") ;Rad/Nuc Location "RTN","ISIIMP23",68,0) K ^VA(200,TPROV,"USC1") ;PERSON Class "RTN","ISIIMP23",69,0) K ^VA(200,TPROV,"USC2") ;Program of Study "RTN","ISIIMP23",70,0) K ^VA(200,TPROV,"USC3") ;user class multiple "RTN","ISIIMP23",71,0) ; "RTN","ISIIMP23",72,0) ;Merge "RTN","ISIIMP23",73,0) I $D(^VA(200,FPROV,.2)) M ^VA(200,TPROV,.2)=^VA(200,FPROV,.2) "RTN","ISIIMP23",74,0) I $D(^VA(200,FPROV,1.2)) M ^VA(200,TPROV,1.2)=^VA(200,FPROV,1.2) ;Terminal type last used "RTN","ISIIMP23",75,0) I $D(^VA(200,FPROV,2)) M ^VA(200,TPROV,2)=^VA(200,FPROV,2) "RTN","ISIIMP23",76,0) I $D(^VA(200,FPROV,3.1)) M ^VA(200,TPROV,3.1)=^VA(200,FPROV,3.1) "RTN","ISIIMP23",77,0) I $D(^VA(200,FPROV,4)) M ^VA(200,TPROV,4)=^VA(200,FPROV,4) "RTN","ISIIMP23",78,0) I $D(^VA(200,FPROV,5)) M ^VA(200,TPROV,5)=^VA(200,FPROV,5) "RTN","ISIIMP23",79,0) I $D(^VA(200,FPROV,19.5)) M ^VA(200,TPROV,19.5)=^VA(200,FPROV,19.5) "RTN","ISIIMP23",80,0) I $D(^VA(200,FPROV,19.6)) M ^VA(200,TPROV,19.6)=^VA(200,FPROV,19.6) "RTN","ISIIMP23",81,0) I $D(^VA(200,FPROV,19.8)) M ^VA(200,TPROV,19.8)=^VA(200,FRPOV,19.8) "RTN","ISIIMP23",82,0) I $D(^VA(200,FPROV,50)) S ^VA(200,TPROV,50)=^VA(200,FPROV,50) "RTN","ISIIMP23",83,0) I $D(^VA(200,FPROV,51)) M ^VA(200,TPROV,51)=^VA(200,FPROV,51) "RTN","ISIIMP23",84,0) I $D(^VA(200,FPROV,52)) M ^VA(200,TPROV,52)=^VA(200,FPROV,52) "RTN","ISIIMP23",85,0) I $D(^VA(200,FPROV,101)) M ^VA(200,TPROV,101)=^VA(200,FPROV,101) "RTN","ISIIMP23",86,0) I $D(^VA(200,FPROV,125)) S ^VA(200,TPROV,125)=^VA(200,FPROV,125) "RTN","ISIIMP23",87,0) I $D(^VA(200,FPROV,200)) S ^VA(200,TPROV,200)=^VA(200,FPROV,200) "RTN","ISIIMP23",88,0) I $D(^VA(200,FPROV,201)) S ^VA(200,TPROV,201)=^VA(200,FPROV,201) "RTN","ISIIMP23",89,0) I $D(^VA(200,FPROV,202.1)) M ^VA(200,TPROV,202.1)=^VA(200,FPROV,202.1) "RTN","ISIIMP23",90,0) I $D(^VA(200,FPROV,203)) M ^VA(200,TPROV,203)=^VA(200,FPROV,203) "RTN","ISIIMP23",91,0) I $D(^VA(200,FPROV,351)) M ^VA(200,TPROV,351)=^VA(200,FPROV,351) "RTN","ISIIMP23",92,0) I $D(^VA(200,FPROV,400)) S ^VA(200,TPROV,400)=^VA(200,FPROV,400) ;supply employee "RTN","ISIIMP23",93,0) I $D(^VA(200,FPROV,450)) S ^VA(200,TPROV,450)=^VA(200,FPROV,450) ;paid employee "RTN","ISIIMP23",94,0) I $D(^VA(200,FPROV,500)) M ^VA(200,TPROV,500)=^VA(200,FPROV,500) "RTN","ISIIMP23",95,0) I $D(^VA(200,FPROV,654)) M ^VA(200,TPROV,500)=^VA(200,FPROV,654) ; social worker "RTN","ISIIMP23",96,0) I $D(^VA(200,FPROV,8910)) M ^VA(200,TPROV,8910)=^VA(200,FPROV,8910) "RTN","ISIIMP23",97,0) I $D(^VA(200,FPROV,"FOF")) M ^VA(200,TPROV,"FOF")=^VA(200,FPROV,"FOF") "RTN","ISIIMP23",98,0) I $D(^VA(200,FPROV,"EC")) M ^VA(200,TPROV,"EC")=^VA(200,FPROV,"EC") "RTN","ISIIMP23",99,0) I $D(^VA(200,FPROV,"LM1")) M ^VA(200,TPROV,"LM1")=^VA(200,FPROV,"LM1") "RTN","ISIIMP23",100,0) I $D(^VA(200,FPROV,"LM2")) M ^VA(200,TPROV,"LM2")=^VA(200,FPROV,"LM2") "RTN","ISIIMP23",101,0) I $D(^VA(200,FPROV,"LM3")) M ^VA(200,TPROV,"LM3")=^VA(200,FPROV,"LM3") "RTN","ISIIMP23",102,0) I $D(^VA(200,FPROV,"LM4")) M ^VA(200,TPROV,"LM4")=^VA(200,FPROV,"LM4") "RTN","ISIIMP23",103,0) I $D(^VA(200,FPROV,"NPI")) M ^VA(200,TPROV,"NPI")=^VA(200,FPROV,"NPI") "RTN","ISIIMP23",104,0) I $D(^VA(200,FPROV,"ORD")) M ^VA(200,TPROV,"ORD")=^VA(200,FPROV,"ORD") "RTN","ISIIMP23",105,0) I $D(^VA(200,FPROV,"PS")) M ^VA(200,TPROV,"PS")=^VA(200,FPROV,"PS") "RTN","ISIIMP23",106,0) I $D(^VA(200,FPROV,"PS1")) M ^VA(200,TPROV,"PS1")=^VA(200,FPROV,"PS1") "RTN","ISIIMP23",107,0) I $D(^VA(200,FPROV,"PS2")) M ^VA(200,TPROV,"PS2")=^VA(200,FPROV,"PS2") "RTN","ISIIMP23",108,0) I $D(^VA(200,FPROV,"PS2")) S ^VA(200,TPROV,"PS2")=^VA(200,FPROV,"PS2") "RTN","ISIIMP23",109,0) I $D(^VA(200,FPROV,"RAC")) M ^VA(200,TPROV,"RAC")=^VA(200,FPROV,"RAC") "RTN","ISIIMP23",110,0) I $D(^VA(200,FPROV,"RAL")) M ^VA(200,TPROV,"RAL")=^VA(200,FPROV,"RAL") "RTN","ISIIMP23",111,0) I $D(^VA(200,FPROV,"USC1")) M ^VA(200,TPROV,"USC1")=^VA(200,FPROV,"USC1") "RTN","ISIIMP23",112,0) I $D(^VA(200,FPROV,"USC2")) M ^VA(200,TPROV,"USC2")=^VA(200,FPROV,"USC2") "RTN","ISIIMP23",113,0) I $D(^VA(200,FPROV,"USC3")) M ^VA(200,TPROV,"USC3")=^VA(200,FPROV,"USC3") "RTN","ISIIMP23",114,0) ; "RTN","ISIIMP23",115,0) ;extra cleanup "RTN","ISIIMP23",116,0) I $D(^VA(200,TPROV,8910)) S $P(^VA(200,TPROV,8910,1,0),"^",3)=TPROV "RTN","ISIIMP23",117,0) I $P(^VA(200,FPROV,0),U,4)="@" S $P(^VA(200,TPROV,0),"^",4)="@" ;file access mode "RTN","ISIIMP23",118,0) ; "RTN","ISIIMP23",119,0) Q "RTN","ISIIMP23",120,0) ; "RTN","ISIIMP23",121,0) CROSSREF(FPROV,TPROV) "RTN","ISIIMP23",122,0) ;Set new cross ref "RTN","ISIIMP23",123,0) N DIV S DA=TPROV,DIK="^VA(200,DA," D IX1^DIK "RTN","ISIIMP23",124,0) Q "RTN","ISIIMP23",125,0) ; "RTN","ISIIMP23",126,0) ; ******************************************************************* "RTN","ISIIMP23",127,0) ; Entry point to copy pnt data from one patient to another "RTN","ISIIMP23",128,0) ; using Dataloader (import) and VPR (export) utilities "RTN","ISIIMP23",129,0) ; "RTN","ISIIMP23",130,0) ; INPUT: "RTN","ISIIMP23",131,0) ; FPNT - FROM PATIENT (#2) "RTN","ISIIMP23",132,0) ; TPNT - TO PATIENT (#2) "RTN","ISIIMP23",133,0) ; OUT: "RTN","ISIIMP23",134,0) ; ISIRC - -1^description if Error "RTN","ISIIMP23",135,0) ; ******************************************************************* "RTN","ISIIMP23",136,0) ; "RTN","ISIIMP23",137,0) COPYPNT(FPNT,TPNT) "RTN","ISIIMP23",138,0) ; "RTN","ISIIMP23",139,0) N X,Y,Z,ZSSN,ISIRESUL "RTN","ISIIMP23",140,0) S FPNT=+$G(FPNT) "RTN","ISIIMP23",141,0) S TPNT=+$G(TPNT) "RTN","ISIIMP23",142,0) I '$D(^DPT(TPNT,0)) Q "RTN","ISIIMP23",143,0) I '$D(^DPT(FPNT,0)) Q "RTN","ISIIMP23",144,0) ; "RTN","ISIIMP23",145,0) D PNTFETCH "RTN","ISIIMP23",146,0) Q "RTN","ISIIMP23",147,0) ; "RTN","ISIIMP23",148,0) PNTFETCH ; "RTN","ISIIMP23",149,0) N TYPE,ISIVPR,ISII,ISIRC "RTN","ISIIMP23",150,0) K ISIVPR S (ISIRC,ISII)=0 "RTN","ISIIMP23",151,0) S TYPE="vitals;problems;allergies;meds" "RTN","ISIIMP23",152,0) ;S TYPE="meds" "RTN","ISIIMP23",153,0) ; "RTN","ISIIMP23",154,0) D LOADMAP(.ISIMAP) "RTN","ISIIMP23",155,0) ; "RTN","ISIIMP23",156,0) D GET^VPRD(.ISIVPR,FPNT,TYPE) "RTN","ISIIMP23",157,0) ; "RTN","ISIIMP23",158,0) D TRANSLAT "RTN","ISIIMP23",159,0) ; "RTN","ISIIMP23",160,0) Q ISIRC "RTN","ISIIMP23",161,0) ; "RTN","ISIIMP23",162,0) LOADMAP(ISIMAP) ; "RTN","ISIIMP23",163,0) N BUF,FILE,FIELD,I,ELEMENT,TRANSFORM "RTN","ISIIMP23",164,0) K ISIMAP "RTN","ISIIMP23",165,0) F I=3:1 S BUF=$P($T(MAPTOEXT+I),";;",2) Q:BUF="" D "RTN","ISIIMP23",166,0) . S ELEMENT=$$TRIM^XLFSTR($P(BUF,"|")) Q:ELEMENT="" "RTN","ISIIMP23",167,0) . S TRANSFORM=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMP23",168,0) . S ISIMAP(ELEMENT)=TRANSFORM ; _"|"_FILE_"|"_FIELD "RTN","ISIIMP23",169,0) Q "RTN","ISIIMP23",170,0) ; "RTN","ISIIMP23",171,0) MAPTOEXT ;; +++ Element translation table *** "RTN","ISIIMP23",172,0) ;; VPR ELEMENT | TRANSFORM "RTN","ISIIMP23",173,0) ;;-------------------------------- "RTN","ISIIMP23",174,0) ;; problem | F - PROBLEM "RTN","ISIIMP23",175,0) ;; allergy | F - ALLERGY "RTN","ISIIMP23",176,0) ;; vital | F - VITAL "RTN","ISIIMP23",177,0) ;; med | F - MEDS "RTN","ISIIMP23",178,0) Q "RTN","ISIIMP23",179,0) ; "RTN","ISIIMP23",180,0) TRANSLAT ; "RTN","ISIIMP23",181,0) N NODE,ELEMENT,TRANS,TRANS1,VALUE,DESCR,LINE,FILE,FIELD "RTN","ISIIMP23",182,0) N ISII S ISII=0 "RTN","ISIIMP23",183,0) F S ISII=$O(@ISIVPR@(ISII)) Q:'ISII D "RTN","ISIIMP23",184,0) . S NODE=$G(@ISIVPR@(ISII)) "RTN","ISIIMP23",185,0) . I $L(NODE)=0 Q "RTN","ISIIMP23",186,0) . S ELEMENT=$TR($P(NODE," "),"<>","") "RTN","ISIIMP23",187,0) . Q:$L(ELEMENT)=0 "RTN","ISIIMP23",188,0) . I '$D(ISIMAP(ELEMENT)) Q "RTN","ISIIMP23",189,0) . S LINE=$G(ISIMAP(ELEMENT)) "RTN","ISIIMP23",190,0) . S TRANS=$P(LINE,"|") "RTN","ISIIMP23",191,0) . S TRANS1=$$TRIM^XLFSTR($P(TRANS,"-",2)) "RTN","ISIIMP23",192,0) . S TRANS=$$TRIM^XLFSTR($P(TRANS,"-")) "RTN","ISIIMP23",193,0) . S DESCR="" "RTN","ISIIMP23",194,0) . I TRANS="F" D FUNCTION "RTN","ISIIMP23",195,0) . Q "RTN","ISIIMP23",196,0) Q "RTN","ISIIMP23",197,0) ; "RTN","ISIIMP23",198,0) FUNCTION ;call to translation functions "RTN","ISIIMP23",199,0) I $T(@TRANS1)]"" D @TRANS1 "RTN","ISIIMP23",200,0) Q "RTN","ISIIMP23",201,0) ; "RTN","ISIIMP23",202,0) VITAL ; "RTN","ISIIMP23",203,0) N ZLINE,ZLOC,ZNUM,ZARY,ZTEST,ZVAL,ZIEN,ZENT,EXIT "RTN","ISIIMP23",204,0) N ZMISC K ZMISC S ISIRC=0 "RTN","ISIIMP23",205,0) ; grab location "RTN","ISIIMP23",206,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"location","measurements") "RTN","ISIIMP23",207,0) I ZNUM'=1 Q "RTN","ISIIMP23",208,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",209,0) S ZLOC=+$P(ZLINE,"code='",2) "RTN","ISIIMP23",210,0) I 'ZLOC Q "RTN","ISIIMP23",211,0) ; grab Date Taken value "RTN","ISIIMP23",212,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"entered","facility") "RTN","ISIIMP23",213,0) I ZNUM'=1 Q "RTN","ISIIMP23",214,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",215,0) S ZENT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",216,0) S ZENT=$P(ZENT,"'") "RTN","ISIIMP23",217,0) I $L(ZENT)=0 S ZENT=$$NOW^XLFDT "RTN","ISIIMP23",218,0) ; grab test values "RTN","ISIIMP23",219,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"measurement","/measurements") "RTN","ISIIMP23",220,0) I 'ZNUM Q "RTN","ISIIMP23",221,0) N Z,Y F Z=1:1:ZNUM S ZLINE=$P($G(ZARY(Z)),U) D "RTN","ISIIMP23",222,0) . I ZLINE'["measurement " Q "RTN","ISIIMP23",223,0) . K ZMISC "RTN","ISIIMP23",224,0) . ; Grab Vital Type "RTN","ISIIMP23",225,0) . S ZTEST=$P(ZLINE,"name='",2) "RTN","ISIIMP23",226,0) . Q:$L(ZTEST)=0 "RTN","ISIIMP23",227,0) . S ZTEST=$P(ZTEST,"'") Q:$L(ZTEST)=0 "RTN","ISIIMP23",228,0) . S Y=$O(^GMRD(120.51,"B",ZTEST,"")) I Y="" D "RTN","ISIIMP23",229,0) . . S Y=$O(^GMRD(120.51,"C",ZTEST,"")) "RTN","ISIIMP23",230,0) . . Q "RTN","ISIIMP23",231,0) . S ZMISC("VITAL_TYPE")=Y "RTN","ISIIMP23",232,0) . ; Get Rate value "RTN","ISIIMP23",233,0) . S ZVAL=$P(ZLINE,"value='",2) "RTN","ISIIMP23",234,0) . S ZVAL=$P(ZVAL,"'") Q:$L(ZVAL)=0 "RTN","ISIIMP23",235,0) . S ZMISC("RATE")=ZVAL "RTN","ISIIMP23",236,0) . S ZMISC("DFN")=TPNT "RTN","ISIIMP23",237,0) . S ZMISC("ENTERED_BY")=$G(DUZ) "RTN","ISIIMP23",238,0) . S ZMISC("LOCATION")=ZLOC "RTN","ISIIMP23",239,0) . S ZMISC("DT_TAKEN")=ZENT "RTN","ISIIMP23",240,0) . S ISIRC=$$IMPORTVT^ISIIMP09(.ZMISC) "RTN","ISIIMP23",241,0) . Q "RTN","ISIIMP23",242,0) ; "RTN","ISIIMP23",243,0) Q "RTN","ISIIMP23",244,0) ; "RTN","ISIIMP23",245,0) PROBLEM ; "RTN","ISIIMP23",246,0) N ZLINE,ZTYP,ZNUM,ZARY,ZTEST,ZVAL,ZIEN,ZENT,EXIT,ZPROV,ZICD,ZSTAT "RTN","ISIIMP23",247,0) N ZICDIEN,ZNAME "RTN","ISIIMP23",248,0) N ZMISC S ISIRC=0 K ZMISC "RTN","ISIIMP23",249,0) ; grab accuity "RTN","ISIIMP23",250,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"acuity","/problem") "RTN","ISIIMP23",251,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",252,0) S ZTYP=$P(ZLINE,"code='",2) "RTN","ISIIMP23",253,0) S ZTYP=$P(ZTYP,"'") "RTN","ISIIMP23",254,0) S ZTYP=$S(ZTYP="A":"A",ZTYP="C":"C",1:"A") "RTN","ISIIMP23",255,0) S ZMISC("TYPE")=ZTYP "RTN","ISIIMP23",256,0) ; grab Onset date value "RTN","ISIIMP23",257,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"onset","/problem") "RTN","ISIIMP23",258,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",259,0) S ZENT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",260,0) S ZENT=$P(ZENT,"'") "RTN","ISIIMP23",261,0) I $L(ZENT)=0 S ZENT=$$NOW^XLFDT "RTN","ISIIMP23",262,0) S ZMISC("ONSET")=ZENT "RTN","ISIIMP23",263,0) ; grab Provider ID "RTN","ISIIMP23",264,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"provider","/problem") "RTN","ISIIMP23",265,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",266,0) S ZPROV=$P(ZLINE,"code='",2) "RTN","ISIIMP23",267,0) S ZPROV=$P(ZPROV,"'") "RTN","ISIIMP23",268,0) Q:'ZPROV "RTN","ISIIMP23",269,0) S ZMISC("PROVIDER")=ZPROV "RTN","ISIIMP23",270,0) ; grab Status value "RTN","ISIIMP23",271,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"status","/problem") "RTN","ISIIMP23",272,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",273,0) S ZSTAT=$P(ZLINE,"code='",2) "RTN","ISIIMP23",274,0) S ZSTAT=$P(ZSTAT,"'") "RTN","ISIIMP23",275,0) Q:$L(ZSTAT)=0 "RTN","ISIIMP23",276,0) S ZMISC("STATUS")=ZSTAT "RTN","ISIIMP23",277,0) ; Grab Problem (ICD9) values "RTN","ISIIMP23",278,0) ; #1 grab icd value "RTN","ISIIMP23",279,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"icd","/problem") "RTN","ISIIMP23",280,0) ;I ZNUM'=1 Q "RTN","ISIIMP23",281,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",282,0) S ZICD=$P(ZLINE,"value='",2) "RTN","ISIIMP23",283,0) S ZICD=$P(ZICD,"'") "RTN","ISIIMP23",284,0) Q:$L(ZICD)=0 "RTN","ISIIMP23",285,0) ; #2 get problem name "RTN","ISIIMP23",286,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"name","/problem") "RTN","ISIIMP23",287,0) ;I ZNUM'=1 Q "RTN","ISIIMP23",288,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",289,0) S ZNAME=$P(ZLINE,"value='",2) "RTN","ISIIMP23",290,0) S ZNAME=$P(ZNAME," (") "RTN","ISIIMP23",291,0) Q:$L(ZNAME)=0 "RTN","ISIIMP23",292,0) S ZNAME=$$UP^XLFSTR(ZNAME) "RTN","ISIIMP23",293,0) ; #3 grab lexicon value "RTN","ISIIMP23",294,0) N OUT,EXPIEN,MAJCON,CODE,ICD "RTN","ISIIMP23",295,0) S (OUT,EXPIEN)="" F S EXPIEN=$O(^LEX(757.01,"B",ZNAME,EXPIEN)) Q:'EXPIEN D Q:OUT=1 "RTN","ISIIMP23",296,0) . S EXPNM=$G(^LEX(757.01,EXPIEN,0)) Q:EXPNM="" "RTN","ISIIMP23",297,0) . S MAJCON=$P($G(^LEX(757.01,EXPIEN,1)),"^") Q:MAJCON="" "RTN","ISIIMP23",298,0) . S CODE="" F S CODE=$O(^LEX(757.02,"AMC",MAJCON,CODE)) Q:'CODE D Q:OUT=1 "RTN","ISIIMP23",299,0) . . S ICD=$P($G(^LEX(757.02,CODE,0)),"^",2) Q:ICD="" "RTN","ISIIMP23",300,0) . . I ICD=ZICD S OUT=1 Q "RTN","ISIIMP23",301,0) . . Q "RTN","ISIIMP23",302,0) I EXPNM="" Q "RTN","ISIIMP23",303,0) I EXPIEN="" Q "RTN","ISIIMP23",304,0) I MAJCON="" Q "RTN","ISIIMP23",305,0) S ZICDIEN=$O(^ICD9("AB",ZICD_" ","")) I ZICDIEN="" Q "RTN","ISIIMP23",306,0) S ZMISC("EXPIEN")=EXPIEN "RTN","ISIIMP23",307,0) S ZMISC("MAJCON")=MAJCON "RTN","ISIIMP23",308,0) S ZMISC("ICD")=ZICD "RTN","ISIIMP23",309,0) S ZMISC("ICDIEN")=ZICDIEN "RTN","ISIIMP23",310,0) S ZMISC("EXPNM")=EXPNM "RTN","ISIIMP23",311,0) S ZMISC("DFN")=TPNT "RTN","ISIIMP23",312,0) S ISIRC=$$CREATE^ISIIMP07(.ZMISC) "RTN","ISIIMP23",313,0) Q "RTN","ISIIMP23",314,0) ; "RTN","ISIIMP23",315,0) ALLERGY ; "RTN","ISIIMP23",316,0) N ZLINE,ZID,ZNUM,ZARY,ZVAL,ZIEN,ZSYMP,ZHIST,ZDT,ZALL,EXIT "RTN","ISIIMP23",317,0) N ZMISC S ISIRC=0 K ZMISC "RTN","ISIIMP23",318,0) ; Set PAT_SSN "RTN","ISIIMP23",319,0) S ZMISC("PAT_SSN")=$P($G(^DPT(TPNT,0)),U,9) "RTN","ISIIMP23",320,0) ; Grab Allergen "RTN","ISIIMP23",321,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"name","/allergy") "RTN","ISIIMP23",322,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",323,0) S ZALL=$P(ZLINE,"value='",2) "RTN","ISIIMP23",324,0) S ZALL=$P(ZALL,"' ") "RTN","ISIIMP23",325,0) I $L(ZALL)=0 Q "RTN","ISIIMP23",326,0) S ZMISC("ALLERGEN")=ZALL "RTN","ISIIMP23",327,0) ; Get #120.8 IEN "RTN","ISIIMP23",328,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"id","/allergy") "RTN","ISIIMP23",329,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",330,0) S ZID=+$P(ZLINE,"value='",2) "RTN","ISIIMP23",331,0) I 'ZID Q "RTN","ISIIMP23",332,0) I '$D(^GMR(120.8,ZID,0)) Q "RTN","ISIIMP23",333,0) ; Grab Originator from ID "RTN","ISIIMP23",334,0) S ZIEN=$P($G(^GMR(120.8,ZID,0)),U,5) "RTN","ISIIMP23",335,0) S ZMISC("ORIGINTR")=$P($G(^VA(200,ZIEN,0)),U) "RTN","ISIIMP23",336,0) ; Grab Symptom "RTN","ISIIMP23",337,0) K ZARY S ZMISC("SYMPTOM")="" "RTN","ISIIMP23",338,0) S ZNUM=$$NESTED(.ZARY,ISII,"reaction","/reactions") "RTN","ISIIMP23",339,0) F X=1:1:ZNUM D "RTN","ISIIMP23",340,0) . S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",341,0) . S ZSYMP=$P(ZLINE,"name='",2) "RTN","ISIIMP23",342,0) . S ZSYMP=$P(ZSYMP,"' ") "RTN","ISIIMP23",343,0) . I $L(ZSYMP)=0 Q "RTN","ISIIMP23",344,0) . S ZMISC("SYMPTOM")=ZMISC("SYMPTOM")_ZSYMP_"|" "RTN","ISIIMP23",345,0) . Q "RTN","ISIIMP23",346,0) ; Grab Historic/Observed "RTN","ISIIMP23",347,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"source","/allergy") "RTN","ISIIMP23",348,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",349,0) S ZHIST=$P(ZLINE,"value='",2) "RTN","ISIIMP23",350,0) S ZHIST=$P(ZHIST,"' ") "RTN","ISIIMP23",351,0) I $L(ZHIST)=0 Q "RTN","ISIIMP23",352,0) S ZHIST=$S(ZHIST="H":1,ZHIST="O":0,1:1) "RTN","ISIIMP23",353,0) S ZMISC("HISTORIC")=ZHIST "RTN","ISIIMP23",354,0) ; Grab Orig Date "RTN","ISIIMP23",355,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"entered","/allergy") "RTN","ISIIMP23",356,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",357,0) S ZDT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",358,0) S ZDT=$P(ZDT,"' ") "RTN","ISIIMP23",359,0) I $L(ZDT)=0 Q "RTN","ISIIMP23",360,0) S Y=ZDT X ^DD("DD") S ZDT=Y "RTN","ISIIMP23",361,0) S ZMISC("ORIG_DATE")=ZDT "RTN","ISIIMP23",362,0) ; Grab Observe Date "RTN","ISIIMP23",363,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"verified","/allergy") "RTN","ISIIMP23",364,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",365,0) S ZDT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",366,0) S ZDT=$P(ZDT,"' ") "RTN","ISIIMP23",367,0) S Y=ZDT X ^DD("DD") S ZDT=Y "RTN","ISIIMP23",368,0) I $L(ZDT)>0 S ZMISC("OBSRV_DT")=ZDT "RTN","ISIIMP23",369,0) E S ZMISC("OBSRV_DT")=ZMISC("ORIG_DATE") "RTN","ISIIMP23",370,0) ; "RTN","ISIIMP23",371,0) S ISIRC=$$VALALG^ISIIMPU6(.ZMISC) "RTN","ISIIMP23",372,0) I +ISIRC<0 Q "RTN","ISIIMP23",373,0) S ISIRC=$$IMPRTALG^ISIIMP11(.ZMISC) "RTN","ISIIMP23",374,0) Q "RTN","ISIIMP23",375,0) ; "RTN","ISIIMP23",376,0) MEDS ; "RTN","ISIIMP23",377,0) N ZLINE,ZID,ZNUM,ZARY,ZPRV,ZDT,EXIT,ZDRUG,ZSIG,ZQNT,ZSUP,ZFIL "RTN","ISIIMP23",378,0) N ZMISC S ISIRC=0 K ZMISC "RTN","ISIIMP23",379,0) ; Set PAT_SSN "RTN","ISIIMP23",380,0) S ZMISC("DFN")=$G(TPNT) "RTN","ISIIMP23",381,0) ; Grab DRUG "RTN","ISIIMP23",382,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"product","/product") "RTN","ISIIMP23",383,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",384,0) S ZDRUG=+$P(ZLINE,"code='",2) "RTN","ISIIMP23",385,0) I '$D(^PSDRUG(ZDRUG,0)) Q "RTN","ISIIMP23",386,0) S ZMISC("DRUG")=$O(^PSDRUG("B",ZDRUG,"")) "RTN","ISIIMP23",387,0) ; Grab issue,dispense,fill date "RTN","ISIIMP23",388,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"lastFilled","/med") "RTN","ISIIMP23",389,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",390,0) S ZDT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",391,0) S ZDT=$P(ZDT,"' ") "RTN","ISIIMP23",392,0) I 'ZDT D "RTN","ISIIMP23",393,0) . K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"ordered","/med") "RTN","ISIIMP23",394,0) . S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",395,0) . S ZDT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",396,0) . S ZDT=$P(ZDT,"' ") "RTN","ISIIMP23",397,0) . Q "RTN","ISIIMP23",398,0) I 'ZDT Q "RTN","ISIIMP23",399,0) S ZMISC("DATE")=ZDT "RTN","ISIIMP23",400,0) ; Grab expiration date "RTN","ISIIMP23",401,0) K ZARY S ZDT="" S ZNUM=$$NESTED(.ZARY,ISII,"expires","/med") "RTN","ISIIMP23",402,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",403,0) S ZDT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",404,0) S ZDT=$P(ZDT,"' ") "RTN","ISIIMP23",405,0) S ZMISC("EXPIRDT")=ZDT "RTN","ISIIMP23",406,0) ; Grab medication instructions "RTN","ISIIMP23",407,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"dose","/doses") "RTN","ISIIMP23",408,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",409,0) S ZSIG=$P(ZLINE,"schedule='",2) "RTN","ISIIMP23",410,0) S ZSIG=$P(ZSIG,"' ") "RTN","ISIIMP23",411,0) I $L(ZSIG)=0 Q "RTN","ISIIMP23",412,0) S ZSIG=$O(^PS(51,"B",ZSIG,"")) "RTN","ISIIMP23",413,0) S ZMISC("SIG")=ZSIG "RTN","ISIIMP23",414,0) ; Grab Quantity "RTN","ISIIMP23",415,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"quantity","/med") "RTN","ISIIMP23",416,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",417,0) S ZQNT=$P(ZLINE,"value='",2) "RTN","ISIIMP23",418,0) S ZQNT=$P(ZQNT,"' ") "RTN","ISIIMP23",419,0) I 'ZQNT Q "RTN","ISIIMP23",420,0) S ZMISC("QTY")=ZQNT "RTN","ISIIMP23",421,0) ; Grab Days Supply "RTN","ISIIMP23",422,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"daysSupply","/med") "RTN","ISIIMP23",423,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",424,0) S ZSUP=$P(ZLINE,"value='",2) "RTN","ISIIMP23",425,0) S ZSUP=$P(ZSUP,"' ") "RTN","ISIIMP23",426,0) I 'ZSUP D "RTN","ISIIMP23",427,0) . S ZSUP=0 K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"dose","/doses") "RTN","ISIIMP23",428,0) . S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",429,0) . S ZSUP=+$P(ZLINE,"dose='",2) "RTN","ISIIMP23",430,0) . Q "RTN","ISIIMP23",431,0) I 'ZSUP Q "RTN","ISIIMP23",432,0) S ZMISC("SUPPLY")=ZSUP "RTN","ISIIMP23",433,0) ; Grab Refills "RTN","ISIIMP23",434,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"fillsAllowed","/med") "RTN","ISIIMP23",435,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",436,0) S ZFIL=$P(ZLINE,"value='",2) "RTN","ISIIMP23",437,0) S ZFIL=$P(ZFIL,"' ") "RTN","ISIIMP23",438,0) I 'ZFIL Q "RTN","ISIIMP23",439,0) S ZMISC("REFILL")=ZFIL "RTN","ISIIMP23",440,0) ; Grab Ordering Provider "RTN","ISIIMP23",441,0) K ZARY S ZNUM=$$NESTED(.ZARY,ISII,"orderingProvider","/med") "RTN","ISIIMP23",442,0) S ZLINE=$P($G(ZARY(1)),U) "RTN","ISIIMP23",443,0) S ZPRV=$P(ZLINE,"code='",2) "RTN","ISIIMP23",444,0) S ZPRV=$P(ZPRV,"' ") "RTN","ISIIMP23",445,0) I '$D(^VA(200,ZPRV,0)) Q "RTN","ISIIMP23",446,0) S ZMISC("PROV")=ZPRV "RTN","ISIIMP23",447,0) ; "RTN","ISIIMP23",448,0) N PSOSITE S PSOSITE=0 F S PSOSITE=$O(^PS(59,PSOSITE)) Q:'PSOSITE D I $G(ZMISC("PSOSITE"))'="" Q "RTN","ISIIMP23",449,0) . S Y=+$G(^PS(59,PSOSITE,"I")) "RTN","ISIIMP23",450,0) . I Y="" S ZMISC("PSOSITE")=PSOSITE Q "RTN","ISIIMP23",451,0) . I Y>DT Q "RTN","ISIIMP23",452,0) . S ZMISC("PSOSITE")=PSOSITE "RTN","ISIIMP23",453,0) . Q "RTN","ISIIMP23",454,0) Q:$G(ZMISC("PSOSITE"))="" "RTN","ISIIMP23",455,0) ; "RTN","ISIIMP23",456,0) S ISIRC=$$MEDS^ISIIMP17(.ZMISC) "RTN","ISIIMP23",457,0) Q "RTN","ISIIMP23",458,0) ; "RTN","ISIIMP23",459,0) NESTED(ZARY,ZISII,ZMATCH,ZTERM) "RTN","ISIIMP23",460,0) ; IN: "RTN","ISIIMP23",461,0) ; ISII starting location "RTN","ISIIMP23",462,0) ; ZMATCH = matching element "RTN","ISIIMP23",463,0) ; ZTERM = terminating element "RTN","ISIIMP23",464,0) ; "RTN","ISIIMP23",465,0) ; OUT: "RTN","ISIIMP23",466,0) ; ZCNT = number of recs found "RTN","ISIIMP23",467,0) ; ZARY(ZCNT) = node_U_ien location "RTN","ISIIMP23",468,0) ; "RTN","ISIIMP23",469,0) N ZNODE,ZELEM,ZCNT,EXIT "RTN","ISIIMP23",470,0) S (ZCNT,EXIT)=0 K ZARY "RTN","ISIIMP23",471,0) S ZISII=+$G(ZISII) Q:'ZISII "RTN","ISIIMP23",472,0) S ZMATCH=$G(ZMATCH) Q:$L(ZMATCH)=0 "RTN","ISIIMP23",473,0) S ZTERM=$G(ZTERM) "RTN","ISIIMP23",474,0) ; "RTN","ISIIMP23",475,0) F S ZISII=$O(@ISIVPR@(ZISII)) Q:'ZISII!(EXIT) D "RTN","ISIIMP23",476,0) . S ZNODE=$G(@ISIVPR@(ZISII)) "RTN","ISIIMP23",477,0) . I $L(ZNODE)=0 Q "RTN","ISIIMP23",478,0) . S ZELEM=$TR($P(ZNODE," "),"<>","") "RTN","ISIIMP23",479,0) . Q:$L(ZELEM)=0 "RTN","ISIIMP23",480,0) . I ZELEM=ZTERM S EXIT=1 Q "RTN","ISIIMP23",481,0) . I ZELEM=ZMATCH S ZCNT=ZCNT+1,ZARY(ZCNT)=ZNODE_U_ZISII Q "RTN","ISIIMP23",482,0) . Q "RTN","ISIIMP23",483,0) Q ZCNT "RTN","ISIIMP24") 0^48^B289695 "RTN","ISIIMP24",1,0) ISIIMP24 ;ISI GROUP/MLS - Template Edit "RTN","ISIIMP24",2,0) ;;1.0;;;Jun 26,2012;Build 58 "RTN","ISIIMP24",3,0) ; "RTN","ISIIMP24",4,0) Q "RTN","ISIIMP24",5,0) ; "RTN","ISIIMP24",6,0) TEMPLATE(ISIRESUL,ISIMISC) "RTN","ISIIMP24",7,0) N ERR,VAL "RTN","ISIIMP24",8,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMP24",9,0) ;Validate setup & parameters "RTN","ISIIMP24",10,0) S ISIRC=$$VALIDATE() Q:+ISIRC<0 ISIRC "RTN","ISIIMP24",11,0) ;Create patient record "RTN","ISIIMP24",12,0) S ISIRC=$$SAVE(.ISIMISC) Q:+ISIRC<0 ISIRC "RTN","ISIIMP24",13,0) ; Quit with DFN "RTN","ISIIMP24",14,0) Q ISIRC "RTN","ISIIMP24",15,0) ; "RTN","ISIIMP24",16,0) VALIDATE() "RTN","ISIIMP24",17,0) ; "RTN","ISIIMP24",18,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP24",19,0) . W !,"+++Template merged params+++",! "RTN","ISIIMP24",20,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC("_X_")=",$G(ISIMISC(X)) "RTN","ISIIMP24",21,0) . W !,"" R X "RTN","ISIIMP24",22,0) . Q "RTN","ISIIMP24",23,0) ; "RTN","ISIIMP24",24,0) ; Validate import array contents "RTN","ISIIMP24",25,0) S ISIRC=$$VALIDATE^ISIIMPUE(.ISIMISC) "RTN","ISIIMP24",26,0) Q ISIRC "RTN","ISIIMP24",27,0) ; "RTN","ISIIMP24",28,0) SAVE(ISIMISC) "RTN","ISIIMP24",29,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMP24",30,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMP24",31,0) ; eg: ISIMISC("NAME")="FIRST,LAST" "RTN","ISIIMP24",32,0) ; "RTN","ISIIMP24",33,0) ; Output - ISIRC [return code] "RTN","ISIIMP24",34,0) ; "RTN","ISIIMP24",35,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMP24",36,0) . W !,"+++ISIMISC array before SAVE^ISIIMP24+++",! "RTN","ISIIMP24",37,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC("_X_")=",$G(ISIMISC(X)) "RTN","ISIIMP24",38,0) . W !,"" R X "RTN","ISIIMP24",39,0) . Q "RTN","ISIIMP24",40,0) ; "RTN","ISIIMP24",41,0) N ZIEN,ZNAME,ZTYPE,ZNAMEMSK,ZSSNMSK,ZSEX,ZEDOB,ZLDOB,ZMSTAT,ZZIPMSK "RTN","ISIIMP24",42,0) N ZPHMSK,ZCITY,ZSTATE,ZVET,ZDFN,ZEMPLOY,ZSERV,ZEMAIL,ZUSER,ZESIG "RTN","ISIIMP24",43,0) N ZACC,ZVER "RTN","ISIIMP24",44,0) ; "RTN","ISIIMP24",45,0) S (ZIEN,ZNAME,ZTYPE,ZNAMEMSK,ZSSNMSK,ZSEX,ZEDOB,ZLDOB,ZMSTAT,ZZIPMSK)="" "RTN","ISIIMP24",46,0) S (ZPHMSK,ZCITY,ZSTATE,ZVET,ZDFN,ZEMPLOY,ZSERV,ZEMAIL,ZUSER,ZESIG,ZACC,ZVER)="" "RTN","ISIIMP24",47,0) ; "RTN","ISIIMP24",48,0) S ZIEN=0 "RTN","ISIIMP24",49,0) ; "RTN","ISIIMP24",50,0) S ISIRC=0,ISIRESUL(0)=0 "RTN","ISIIMP24",51,0) ; "RTN","ISIIMP24",52,0) S ZNAME=$G(ISIMISC("NAME")) "RTN","ISIIMP24",53,0) I $D(^ISI(9001,"B",ZNAME)) S ZIEN=$O(^ISI(9001,"B",ZNAME,"")) "RTN","ISIIMP24",54,0) I ZIEN D UPDATE "RTN","ISIIMP24",55,0) ;I 'ZIEN D NEW "RTN","ISIIMP24",56,0) ; "RTN","ISIIMP24",57,0) Q ISIRC "RTN","ISIIMP24",58,0) ; "RTN","ISIIMP24",59,0) UPDATE ; "RTN","ISIIMP24",60,0) N FDA,IENS,MSG K FDA "RTN","ISIIMP24",61,0) S ISIRC=0 "RTN","ISIIMP24",62,0) S IENS=ZIEN_"," "RTN","ISIIMP24",63,0) D POPLIST "RTN","ISIIMP24",64,0) D MKARRY "RTN","ISIIMP24",65,0) D FILE^DIE("E","FDA","MSG") "RTN","ISIIMP24",66,0) I $G(DIERR) S ISIRC="-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP24",67,0) Q "RTN","ISIIMP24",68,0) ; "RTN","ISIIMP24",69,0) NEW ; "RTN","ISIIMP24",70,0) N FDA,IENS K FDA "RTN","ISIIMP24",71,0) S IENS="+1," "RTN","ISIIMP24",72,0) S ISIRC=0 "RTN","ISIIMP24",73,0) D POPLIST "RTN","ISIIMP24",74,0) D MKARRY "RTN","ISIIMP24",75,0) D UPDATE^DIE("E","FDA",,"MSG") "RTN","ISIIMP24",76,0) I $G(DIERR)'="" S ISIRC="-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP24",77,0) Q ISIRC "RTN","ISIIMP24",78,0) ; "RTN","ISIIMP24",79,0) POPLIST ; "RTN","ISIIMP24",80,0) ; "RTN","ISIIMP24",81,0) S ZNAME=$G(ISIMISC("NAME")) "RTN","ISIIMP24",82,0) S ZTYPE=$G(ISIMISC("TYPE")) "RTN","ISIIMP24",83,0) S ZNAMEMSK=$G(ISIMISC("NAME_MASK")) "RTN","ISIIMP24",84,0) S ZSSNMSK=$G(ISIMISC("SSN_MASK")) "RTN","ISIIMP24",85,0) S ZSEX=$G(ISIMISC("SEX")) "RTN","ISIIMP24",86,0) S ZEDOB=$G(ISIMISC("EDOB")) "RTN","ISIIMP24",87,0) S ZLDOB=$G(ISIMISC("LDOB")) "RTN","ISIIMP24",88,0) S ZMSTAT=$G(ISIMISC("MARITAL_STATUS")) "RTN","ISIIMP24",89,0) S ZZIPMSK=$G(ISIMISC("ZIP_MASK")) "RTN","ISIIMP24",90,0) S ZPHMSK=$G(ISIMISC("PH_NUM")) "RTN","ISIIMP24",91,0) S ZCITY=$G(ISIMISC("CITY")) "RTN","ISIIMP24",92,0) S ZSTATE=$G(ISIMISC("STATE")) "RTN","ISIIMP24",93,0) S ZVET=$G(ISIMISC("VETERAN")) "RTN","ISIIMP24",94,0) S ZDFN=$G(ISIMISC("DFN_NAME")) "RTN","ISIIMP24",95,0) S ZEMPLOY=$G(ISIMISC("EMPLOY_STAT")) "RTN","ISIIMP24",96,0) S ZSERV=$G(ISIMISC("SERVICE")) "RTN","ISIIMP24",97,0) S ZEMAIL=$G(ISIMISC("EMAIL_MASK")) "RTN","ISIIMP24",98,0) S ZUSER=$G(ISIMISC("USER_MASK")) "RTN","ISIIMP24",99,0) S ZESIG=$G(ISIMISC("ESIG_APND")) "RTN","ISIIMP24",100,0) S ZACC=$G(ISIMISC("ACCESS_APND")) "RTN","ISIIMP24",101,0) S ZVER=$G(ISIMISC("VERIFY_APND")) "RTN","ISIIMP24",102,0) Q "RTN","ISIIMP24",103,0) ; "RTN","ISIIMP24",104,0) MKARRY "RTN","ISIIMP24",105,0) ; "RTN","ISIIMP24",106,0) S FDA(9001,IENS,.01)=ZNAME "RTN","ISIIMP24",107,0) I $G(ZTYPE)'="" S FDA(9001,IENS,1)=ZTYPE "RTN","ISIIMP24",108,0) I $G(ZNAMEMSK)'="" S FDA(9001,IENS,2)=ZNAMEMSK "RTN","ISIIMP24",109,0) I $G(ZSSNMSK)'="" S FDA(9001,IENS,4)=ZSSNMSK "RTN","ISIIMP24",110,0) I $G(ZSEX)'="" S FDA(9001,IENS,5)=ZSEX "RTN","ISIIMP24",111,0) I $G(ZEDOB)'="" S FDA(9001,IENS,6)=ZEDOB "RTN","ISIIMP24",112,0) I $G(ZLDOB)'="" S FDA(9001,IENS,7)=ZLDOB "RTN","ISIIMP24",113,0) I $G(ZMSTAT)'="" S FDA(9001,IENS,8)=ZMSTAT "RTN","ISIIMP24",114,0) I $G(ZZIPMSK)'="" S FDA(9001,IENS,9)=ZZIPMSK "RTN","ISIIMP24",115,0) I $G(ZPHMSK)'="" S FDA(9001,IENS,10)=ZPHMSK "RTN","ISIIMP24",116,0) I $G(ZCITY)'="" S FDA(9001,IENS,11)=ZCITY "RTN","ISIIMP24",117,0) I $G(ZSTATE)'="" S FDA(9001,IENS,12)=ZSTATE "RTN","ISIIMP24",118,0) I $G(ZVET)'="" S FDA(9001,IENS,13)=ZVET "RTN","ISIIMP24",119,0) I $G(ZDFN)'="" S FDA(9001,IENS,14)=ZDFN "RTN","ISIIMP24",120,0) I $G(ZEMPLOY)'="" S FDA(9001,IENS,15)=ZEMPLOY "RTN","ISIIMP24",121,0) I $G(ZSERV)'="" S FDA(9001,IENS,16)=ZSERV "RTN","ISIIMP24",122,0) I $G(ZEMAIL)'="" S FDA(9001,IENS,17)=ZEMAIL "RTN","ISIIMP24",123,0) I $G(ZUSER)'="" S FDA(9001,IENS,18)=ZUSER "RTN","ISIIMP24",124,0) I $G(ZESIG)'="" S FDA(9001,IENS,19)=ZESIG "RTN","ISIIMP24",125,0) I $G(ZACC)'="" S FDA(9001,IENS,20)=ZACC "RTN","ISIIMP24",126,0) I $G(ZVER)'="" S FDA(9001,IENS,21)=ZVER "RTN","ISIIMP24",127,0) Q "RTN","ISIIMP25") 0^49^B3484 "RTN","ISIIMP25",1,0) ISIIMP25 ;ISI Group/MLS -- ADMIT patient "RTN","ISIIMP25",2,0) ;;1.0;;;DEC 15,2014;Build 58 "RTN","ISIIMP25",3,0) Q "RTN","ISIIMP25",4,0) ; "RTN","ISIIMP25",5,0) ADMIT(ISIMISC) "RTN","ISIIMP25",6,0) ; "RTN","ISIIMP25",7,0) ; ***VERY ROUGH TEST OF CONCEPT ONLY *** "RTN","ISIIMP25",8,0) ; "RTN","ISIIMP25",9,0) S ISIRC=0 "RTN","ISIIMP25",10,0) ; "RTN","ISIIMP25",11,0) S VAINDT=ADATE "RTN","ISIIMP25",12,0) D INP^VADPT "RTN","ISIIMP25",13,0) I $G(VAIN(1))]"" S ISIRC="-9^Admit Error: Patient already admitted" "RTN","ISIIMP25",14,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP25",15,0) D MAKEADM "RTN","ISIIMP25",16,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP25",17,0) Q 1 "RTN","ISIIMP25",18,0) ; "RTN","ISIIMP25",19,0) MAKEADM "RTN","ISIIMP25",20,0) ; Admit the patient "RTN","ISIIMP25",21,0) N %,%H,%I,NOW,NOWI,VAX,VAZ,VAZ2,E,VACC,VAIP,VAQ,VANN,VASET "RTN","ISIIMP25",22,0) N DGPMDA,DGPMSP,DGPMT,DGPMVI,DGUSEOR,DGPMMD,DEF,DGPM1X,DGPMY,DGPMN "RTN","ISIIMP25",23,0) ; "RTN","ISIIMP25",24,0) ; kill, clean-up variables "RTN","ISIIMP25",25,0) D Q^DGPMV3 "RTN","ISIIMP25",26,0) D Q^DGPMV2 "RTN","ISIIMP25",27,0) D KVAR^VADPT K DGPM2X,DGPMIFN,DGPMDCD,DGPMVI,DGPMY,DIE,DR,I,J,X,X1,Z "RTN","ISIIMP25",28,0) ; "RTN","ISIIMP25",29,0) S (ISIRC,DGPMT)=1,DGUSEOR=0,DGPMN="" "RTN","ISIIMP25",30,0) ; "RTN","ISIIMP25",31,0) I $$GET1^DIQ(2,DFN,.351,"I") S ISIRC="-1^Admit Error: Patient expired" Q "RTN","ISIIMP25",32,0) ; get lodger status "RTN","ISIIMP25",33,0) I $$LODGER^DGPMV(DFN) D "RTN","ISIIMP25",34,0) . S ISIRC="-1^Admit Error: Patient is a lodger...you can not add an admission!" "RTN","ISIIMP25",35,0) . D DISPOQ^DGPMV "RTN","ISIIMP25",36,0) . K DGPMDER "RTN","ISIIMP25",37,0) I ISIRC<1 D EXIT Q "RTN","ISIIMP25",38,0) ; "RTN","ISIIMP25",39,0) ;;; MOVE^DGPMV "RTN","ISIIMP25",40,0) S XQORQUIT=1,DGPME=0 D UC^DGPMV "RTN","ISIIMP25",41,0) ; "RTN","ISIIMP25",42,0) I $G(ADATE) S DGPMY=ADATE "RTN","ISIIMP25",43,0) K VAIP S VAIP("D")="L",VAIP("L")="" "RTN","ISIIMP25",44,0) D INP^DGPMV10,Q^VADPT3 "RTN","ISIIMP25",45,0) S X=$P($G(^DPT(DFN,0)),"^",14) I X D "RTN","ISIIMP25",46,0) . D DOM^DGMTR D:'$G(DGDOM) DIS^DGMTU(DFN) K DGDOM "RTN","ISIIMP25",47,0) ; "RTN","ISIIMP25",48,0) ;;; C^DGPMV1 "RTN","ISIIMP25",49,0) S DGPM2X=0 ;were DGPMVI variables set 2 times? "RTN","ISIIMP25",50,0) I DGPMT=1,+DGPMVI(2)=4,'$D(^DGPM("APTT1",DFN)) D "RTN","ISIIMP25",51,0) . S ISIRC="-1^Admit Error: THIS PATIENT IS A LODGER AND HAS NO ADMISSIONS ON FILE; YOU MUST CHECK HIM OUT PRIOR TO CONTINUING" "RTN","ISIIMP25",52,0) I (ISIRC<0) D EXIT Q "RTN","ISIIMP25",53,0) ; "RTN","ISIIMP25",54,0) I "^1^2^6"[("^"_+DGPMVI(2)_"^")&("^4^5^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=3&(DGPMT=5)) D LODGER^DGPMV10 S DGPM2X=1 "RTN","ISIIMP25",55,0) I +DGPMVI(2)=4&("^1^2^3^6^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=5&(DGPMT=3)) K VAIP S VAIP("D")="L" D INP^DGPMV10 S DGPM2X=1 "RTN","ISIIMP25",56,0) ;;; ^DGPMV2 "RTN","ISIIMP25",57,0) I '$D(DGPMVI) D "RTN","ISIIMP25",58,0) . S ISIRC="-1^Admit Error: INPATIENT ARRAY NOT DEFINED...MODULE ENTERED INCORRECTLY" "RTN","ISIIMP25",59,0) I (ISIRC<0) D EXIT Q "RTN","ISIIMP25",60,0) ; "RTN","ISIIMP25",61,0) I '$D(DGPMVI) S ISIRC="-1^Admit Error: Missing DGPMVI" D EXIT Q "RTN","ISIIMP25",62,0) ; "RTN","ISIIMP25",63,0) K DGPME S DGPMMD="",DEF="NOW",DGPM1X=0 D S^DGPMV2 I "^1^4^5^"'[("^"_DGPMT_"^") D PTF^DGPMV21 "RTN","ISIIMP25",64,0) I $D(DGPME) S ISIRC="-1^Admit Error: Missing PTF" D EXIT Q "RTN","ISIIMP25",65,0) ; "RTN","ISIIMP25",66,0) D NOW^%DTC,S1^DGPMV2 "RTN","ISIIMP25",67,0) S DGPML=$S($D(^UTILITY("DGPMVN",$J,1)):$P(^(1),"^",2),1:"") K C,D,I,J,N "RTN","ISIIMP25",68,0) S:$S('DGPMDCD:1,DGPMDCD>%:1,DGPM2X:1,1:0)&$S(DGPMT=1:1,DGPMT=4:1,1:0) DGPMMD=DGPML I $S('DGPMDCD:0,DGPMT=3:1,DGPMT=5:1,DGPMDCD'>%:1,1:0)&$S(DGPMT=1:0,DGPMT=4:0,1:1) S DGPMMD=DGPML,DEF="" "RTN","ISIIMP25",69,0) I $S(DGPMT=2:1,DGPMT=6:1,1:0),DGPMDCD,(DGPMDCD<%) S DEF="" "RTN","ISIIMP25",70,0) ; "RTN","ISIIMP25",71,0) I $D(DGPME),(DGPME="***") D Q^DGPMV2 S ISIRC="-1^Admit Error: No PTF "_$G(DGPME) D EXIT Q "RTN","ISIIMP25",72,0) ; "RTN","ISIIMP25",73,0) K DGPME I DGPMMD S Y=DGPMMD X ^DD("DD") S DEF=Y "RTN","ISIIMP25",74,0) N DGPMN S DGPMN=0 "RTN","ISIIMP25",75,0) S DGPMSA=0 D SCHDQ^DGPMV22 ;not a scheduled admission "RTN","ISIIMP25",76,0) K ^UTILITY("DGPM",$J) S (DGPMHY,X)=DGPMY,DGPMOUT=0 "RTN","ISIIMP25",77,0) ;S DGPM0ND=DGPMY_"^"_DGPMT_"^"_DFN_"^^^^^^^^^^^" "RTN","ISIIMP25",78,0) S DGPM0ND=DGPMY_"^"_DGPMT_"^"_DFN_"^^^^^^^^^^^"_$S("^1^4^"[("^"_DGPMT_"^"):"",1:DGPMCA) "RTN","ISIIMP25",79,0) I DGPMT=1 S $P(DGPM0ND,"^",25)=$S(DGPMSA:1,1:0) "RTN","ISIIMP25",80,0) D NEW^DGPMV3 ;+10^DGPMV3 "RTN","ISIIMP25",81,0) I Y>0 S (DA,DGPMDA)=+Y "RTN","ISIIMP25",82,0) I 'DGPMDA S ISIRC="-1^Admit Error: Missing movement ien" D EXIT Q "RTN","ISIIMP25",83,0) N ZPMDA S ZPMDA=DGPMDA,DGPMCA=DA,DGPMAN=^DGPM(DA,0) D VAR^DGPMV3 "RTN","ISIIMP25",84,0) N SC,ISIVIEN S SC=$$GET1^DIQ(42,ISIWARDIEN,44,"I") I 'SC S ISIRC="-1^ERROR: Can't find Hospital Location." D EXIT Q "RTN","ISIIMP25",85,0) S ISIVIEN=$$VISIT^ISIIMP05(DFN,SC,ADATE,"I") "RTN","ISIIMP25",86,0) I 'ISIVIEN S ISIRC="-1^Admit Error: Unable to Create Visit IEN" D EXIT Q "RTN","ISIIMP25",87,0) N ZFDA,IENS,ZMSG S IENS=DGPMDA_"," "RTN","ISIIMP25",88,0) S ZFDA(405,IENS,.1)="No admit diagnosis text." "RTN","ISIIMP25",89,0) S ZFDA(405,IENS,.04)=ISITYPEIEN "RTN","ISIIMP25",90,0) S ZFDA(405,IENS,.06)=ISIWARDIEN "RTN","ISIIMP25",91,0) S ZFDA(405,IENS,.07)=ISIRMBDIEN ;ISIRMBDIEN "RTN","ISIIMP25",92,0) S ZFDA(405,IENS,.09)=ISIFTSIEN "RTN","ISIIMP25",93,0) S ZFDA(405,IENS,.11)=0 "RTN","ISIIMP25",94,0) S ZFDA(405,IENS,.12)=99 "RTN","ISIIMP25",95,0) ;S ZFDA(405,IENS,.14)= "RTN","ISIIMP25",96,0) ;S ZFDA(405,IENS,.16)= "RTN","ISIIMP25",97,0) S ZFDA(405,IENS,.18)=ISIMASIEN "RTN","ISIIMP25",98,0) S ZFDA(405,IENS,.19)=ISIPROV "RTN","ISIIMP25",99,0) S ZFDA(405,IENS,.27)=ISIVIEN "RTN","ISIIMP25",100,0) S ZFDA(405,IENS,41)=ISIFAC "RTN","ISIIMP25",101,0) S ZFDA(405,IENS,42)=$$NOW^XLFDT "RTN","ISIIMP25",102,0) S ZFDA(405,IENS,43)=DUZ "RTN","ISIIMP25",103,0) S ZFDA(405,IENS,102)=DUZ ;Last Edited By (Service user) "RTN","ISIIMP25",104,0) S ZFDA(405,IENS,103)=$$NOW^XLFDT "RTN","ISIIMP25",105,0) D FILE^DIE(,"ZFDA","ZMSG") ;File patient movement fields first "RTN","ISIIMP25",106,0) I $G(DIERR) S ISIRC="-1^Admit Error: updating movment file" D EXIT Q "RTN","ISIIMP25",107,0) I $G(ZPMDA),$L($G(ISIWARD)) S ^DGPM("CN",ISIWARD,ZPMDA)="" "RTN","ISIIMP25",108,0) S:DGPMT=1!(DGPMT=4) DGPMCA=+IENS,DGPMAN=^DGPM(+IENS,0) ;D VAR G DR "RTN","ISIIMP25",109,0) D VAR^DGPMV3 "RTN","ISIIMP25",110,0) ; "RTN","ISIIMP25",111,0) K DGZ S (^UTILITY("DGPM",$J,DGPMT,DGPMDA,"A"),DGPMA)=$S($D(^DGPM(DGPMDA,0)):^(0),1:"") ;I DGPMT=6 S Y=DGPMDA D AFTER^DGPMV36 "RTN","ISIIMP25",112,0) ; go to PTF^DGPMV31 "RTN","ISIIMP25",113,0) ; "RTN","ISIIMP25",114,0) K ZFDA S IENS=DFN_"," "RTN","ISIIMP25",115,0) S ZFDA(2,IENS,.1)=ISIWARDIEN "RTN","ISIIMP25",116,0) S ZFDA(2,IENS,.101)=ISIRMBDIEN "RTN","ISIIMP25",117,0) S ZFDA(2,IENS,.102)=ZPMDA ;Current movement "RTN","ISIIMP25",118,0) S ZFDA(2,IENS,.105)=ZPMDA ;Current admission "RTN","ISIIMP25",119,0) S ZFDA(2,IENS,.108)=ISIRMBDIEN ;Current room "RTN","ISIIMP25",120,0) D FILE^DIE(,"ZFDA","ZMSG") ;File patient fields "RTN","ISIIMP25",121,0) I $G(DIERR) S ISIRC="-1^Admit Error: updating patient file" D EXIT Q "RTN","ISIIMP25",122,0) I $G(ZPMDA),$L($G(ISIWARD)) S ^DPT("CN",ISIWARD,DFN)=ZPMDA "RTN","ISIIMP25",123,0) ;;; DR^DGPMV3 "RTN","ISIIMP25",124,0) S DIE="^DGPM(" I "^1^4^6^"[("^"_DGPMT_"^"),DGPMN S DIE("NO^")="" "RTN","ISIIMP25",125,0) S DGODSPT=$S('$D(^DGPM(DGPMCA,"ODS")):0,^("ODS"):1,1:0) "RTN","ISIIMP25",126,0) S PTF=$P(DGPMA,"^",16) "RTN","ISIIMP25",127,0) N DGELA "RTN","ISIIMP25",128,0) S DGELA=+$P($G(^DGPT(+PTF,101)),U,8) "RTN","ISIIMP25",129,0) S DR="",DIE="^DGPT(" S:$S('$D(^DGPT(+PTF,0)):0,$P(^(0),"^",2)'=+DGPMA:1,1:0) DR=DR_"2////"_+DGPMA_";" "RTN","ISIIMP25",130,0) S DA=PTF I $D(^DGPT(+DA,0)) K DQ,DG D ^DIE "RTN","ISIIMP25",131,0) S Y=+DGPMA "RTN","ISIIMP25",132,0) ; "RTN","ISIIMP25",133,0) ;;; CREATE^DGPTFCR "RTN","ISIIMP25",134,0) S DGPTDATA=U_Y,DIC="^DGPT(",DIC("DR")="[DG PTF CREATE PTF ENTRY]" "RTN","ISIIMP25",135,0) S DIC(0)="FLZ",X=DFN K DD,DO D FILE^DICN S Y=+Y "RTN","ISIIMP25",136,0) S PTF=Y "RTN","ISIIMP25",137,0) S DIE="^DGPM(",DA=DGPMDA,DR=".16////"_+Y K DQ,DG D ^DIE "RTN","ISIIMP25",138,0) ; "RTN","ISIIMP25",139,0) S (^UTILITY("DGPM",$J,DGPMT,DGPMDA,"A"),DGPMA)=$G(^DGPM(DGPMDA,0))_$S($G(^("DIR"))'="":U_^("DIR"),1:"") I DGPMT=6 S Y=DGPMDA D AFTER^DGPMV36 "RTN","ISIIMP25",140,0) ; "RTN","ISIIMP25",141,0) ; drop into EVENTS^DGPMV3 "RTN","ISIIMP25",142,0) ;;; EVENTS^DGPMV3 "RTN","ISIIMP25",143,0) I DGPMT'=4&(DGPMT'=5) D RESET^DGPMDDCN I (DGPMT'=6) D SI^DGPMV33 "RTN","ISIIMP25",144,0) S DGOK=0 F I=0:0 S I=$O(^UTILITY("DGPM",$J,I)) Q:'I F J=0:0 S J=$O(^UTILITY("DGPM",$J,I,J)) Q:'J I ^(J,"A")'=^("P") S DGOK=1 "RTN","ISIIMP25",145,0) I DGOK D ^DGPMEVT ;Invoke Movement Event Driver "RTN","ISIIMP25",146,0) D Q^DGPMV3 "RTN","ISIIMP25",147,0) L -^DGPM("C",DFN) "RTN","ISIIMP25",148,0) K ^UTILITY("DGPM",$J) "RTN","ISIIMP25",149,0) ; "RTN","ISIIMP25",150,0) Q "RTN","ISIIMP25",151,0) ; "RTN","ISIIMP25",152,0) EXIT ; "RTN","ISIIMP25",153,0) D Q^DGPMV3 "RTN","ISIIMP25",154,0) L -^DGPM("C",DFN) "RTN","ISIIMP25",155,0) K ^UTILITY("DGPM",$J) "RTN","ISIIMP25",156,0) Q "RTN","ISIIMP26") 0^50^B39578448 "RTN","ISIIMP26",1,0) ISIIMP26 ;ISI Group/MLS -- discharge patient, DG DISCHARGE PATIENT "RTN","ISIIMP26",2,0) ;;1.0;;;DEC 15,2014;Build 58 "RTN","ISIIMP26",3,0) ; "RTN","ISIIMP26",4,0) Q "RTN","ISIIMP26",5,0) ; "RTN","ISIIMP26",6,0) ; DFN ; patient ien (FIFTYNINE,PATIENT) "RTN","ISIIMP26",7,0) ; ISIMISC("admitDate") ; admit datetime (past) "RTN","ISIIMP26",8,0) ; ISIMISC("dischargeDateTime") ; "RTN","ISIIMP26",9,0) ; ISIMISC("typeOfMovement") ; "DISCHARGED TO HOME" "RTN","ISIIMP26",10,0) ; ISIMISC("masMovementType") ; "REGULAR" "RTN","ISIIMP26",11,0) ; "RTN","ISIIMP26",12,0) DISCHARG(ISIMISC) ; discharge patient (DG DISCHARGE PATIENT) "RTN","ISIIMP26",13,0) N ISIDDATE,ISITYPE,ISITYPEIEN,ISIMAS,ISIMASIEN "RTN","ISIIMP26",14,0) S ISIRC=1,DGQUIET=1 "RTN","ISIIMP26",15,0) ; "RTN","ISIIMP26",16,0) I DFN<1 D "RTN","ISIIMP26",17,0) . S ISIRC="-1^Input Error: DFN is not valid" "RTN","ISIIMP26",18,0) QUIT:ISIRC'=1 ISIRC "RTN","ISIIMP26",19,0) ; "RTN","ISIIMP26",20,0) S ISIDDATE=$G(ISIMISC("dischargeDateTime")) "RTN","ISIIMP26",21,0) I ISIDDATE="" S ISIDDATE="NOW" "RTN","ISIIMP26",22,0) ; "RTN","ISIIMP26",23,0) S ISITYPE=$G(ISIMISC("typeOfMovement")) "RTN","ISIIMP26",24,0) S ISITYPEIEN=$O(^DG(405.1,"B",ISITYPE,"")) ; TYPE OF MOVEMENT "RTN","ISIIMP26",25,0) I ISITYPEIEN<1 D "RTN","ISIIMP26",26,0) . S ISIRC="-1^Input Error: Type of Movement is not valid" "RTN","ISIIMP26",27,0) QUIT:ISIRC'=1 ISIRC "RTN","ISIIMP26",28,0) ; "RTN","ISIIMP26",29,0) S ISIMAS=$G(ISIMISC("masMovementType")) "RTN","ISIIMP26",30,0) S ISIMASIEN=$O(^DG(405.2,"B",ISIMAS,"")) ; MAS MOVEMENT TYPE "RTN","ISIIMP26",31,0) I ISIMASIEN<1 D "RTN","ISIIMP26",32,0) . S ISIRC="-1^Input Error: MAS Movement Type is not valid" "RTN","ISIIMP26",33,0) QUIT:ISIRC'=1 ISIRC "RTN","ISIIMP26",34,0) ;;; entry action of DG DISCHARGE PATIENT "RTN","ISIIMP26",35,0) S DGPMT=3 "RTN","ISIIMP26",36,0) ;;; PAT^DGMPV "RTN","ISIIMP26",37,0) K ORACTION,ORMENU "RTN","ISIIMP26",38,0) ;;; PAT1^DGPMV "RTN","ISIIMP26",39,0) S DGPMN=0 "RTN","ISIIMP26",40,0) ;;; MOVE^DGPMV "RTN","ISIIMP26",41,0) S XQORQUIT=1,DGPME=0 D UC^DGPMV "RTN","ISIIMP26",42,0) ;;; CHK^DGPMV "RTN","ISIIMP26",43,0) ; check for patient expiration "RTN","ISIIMP26",44,0) I 'DGPME,$D(^DPT(DFN,.35)),+^(.35) D "RTN","ISIIMP26",45,0) . S Y=+^(.35) "RTN","ISIIMP26",46,0) . S ISIRC="-1^Discharge Error: Patient expired." "RTN","ISIIMP26",47,0) QUIT:ISIRC'=1 ISIRC "RTN","ISIIMP26",48,0) ;;; ^DGPMV1 "RTN","ISIIMP26",49,0) K VAIP S VAIP("D")="L",VAIP("L")="" D INP^DGPMV10,Q^VADPT3 "RTN","ISIIMP26",50,0) S X=$P($G(^DPT(DFN,0)),"^",14) I X D "RTN","ISIIMP26",51,0) . D DOM^DGMTR D:'$G(DGDOM) DIS^DGMTU(DFN) K DGDOM "RTN","ISIIMP26",52,0) ;;; CS^DGPMV10 "RTN","ISIIMP26",53,0) I '$D(^DGPM("C",DFN)) D "RTN","ISIIMP26",54,0) . S ISIRC="-1^Discharge Error: PATIENT HAS NO INPATIENT OR LODGER ACTIVITY IN THE COMPUTER" "RTN","ISIIMP26",55,0) QUIT:ISIRC'=1 ISIRC "RTN","ISIIMP26",56,0) ; "RTN","ISIIMP26",57,0) ; drop to C^DGPMV1 "RTN","ISIIMP26",58,0) S DGPM2X=0 ;were DGPMVI variables set 2 times? "RTN","ISIIMP26",59,0) I "^1^2^6"[("^"_+DGPMVI(2)_"^")&("^4^5^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=3&(DGPMT=5)) D LODGER^DGPMV10 S DGPM2X=1 "RTN","ISIIMP26",60,0) I +DGPMVI(2)=4&("^1^2^3^6^"[("^"_DGPMT_"^"))!(+DGPMVI(2)=5&(DGPMT=3)) K VAIP S VAIP("D")="L" D INP^DGPMV10 S DGPM2X=1 "RTN","ISIIMP26",61,0) ; "RTN","ISIIMP26",62,0) ;;; ^DGPMV2 "RTN","ISIIMP26",63,0) I '$D(DGPMVI) D "RTN","ISIIMP26",64,0) . S ISIRC="-1^Discharge Error: INPATIENT ARRAY NOT DEFINED...MODULE ENTERED INCORRECTLY" "RTN","ISIIMP26",65,0) QUIT:ISIRC'=1 ISIRC "RTN","ISIIMP26",66,0) ; "RTN","ISIIMP26",67,0) K DGPME S DGPMMD="",DEF="NOW",DGPM1X=0 D S^DGPMV2 "RTN","ISIIMP26",68,0) I DGPMT=3!(DGPMT=5) K DGPME ;G OLD:DGPMDCD S DGPML="",DGPM1X=1 G NEW "RTN","ISIIMP26",69,0) S DGPML="",DGPM1X=1 "RTN","ISIIMP26",70,0) ; "RTN","ISIIMP26",71,0) ;;; NEW^DGPMV2 "RTN","ISIIMP26",72,0) S DGX=$S(DGPMT=5:7,DGPMT=6:20,1:0) I DGX S DGONE=1 I $O(^DG(405.1,"AM",DGX,+$O(^DG(405.1,"AM",DGX,0)))) S DGONE=0 "RTN","ISIIMP26",73,0) I 'DGX S DGONE=0 "RTN","ISIIMP26",74,0) ; "RTN","ISIIMP26",75,0) ;;; SEL2^DGPMV2 "RTN","ISIIMP26",76,0) S ISITEST=0 ; added by Lenny "RTN","ISIIMP26",77,0) S DGPMN=0 "RTN","ISIIMP26",78,0) S X=$G(ISIMISC("dischargeDateTime")) "RTN","ISIIMP26",79,0) D NOW^%DTC S DGPMN=1,(DGZ,Y)=% X ^DD("DD") S Y=DGZ "RTN","ISIIMP26",80,0) ; "RTN","ISIIMP26",81,0) ;;; CONT^DGPMV2 "RTN","ISIIMP26",82,0) S DGPMY=+Y,DGPMDA=$S($D(^UTILITY("DGPMVD",$J,+Y)):+^(Y),1:"") I DGPMT=1!(DGPMT=4) S DGPMCA=+DGPMDA,DGPMAN=$S($D(^DGPM(DGPMCA,0)):^(0),1:DGPMY) "RTN","ISIIMP26",83,0) K %DT ;D ^DGPMV21,SCHDADM^DGPMV22:DGPMT=1&DGPMN,^DGPMV3:DGPMY I $D(DGPME) W:DGPME'="***" !,DGPME G SEL "RTN","ISIIMP26",84,0) ; "RTN","ISIIMP26",85,0) ;;; ^DGPMV21 "RTN","ISIIMP26",86,0) S DGPME="" "RTN","ISIIMP26",87,0) I $S('$D(DGPMY):1,DGPMY?7N:0,DGPMY'?7N1".".N:1,1:0) S DGPME="DATE EITHER NOT PASSED OR NOT IN EXPECTED VA FILEMANAGER FORMAT" "RTN","ISIIMP26",88,0) I $S('$D(DGPMT):1,'DGPMT:1,1:0) S DGPME="TRANSACTION TYPE IS NOT DEFINED" "RTN","ISIIMP26",89,0) ; "RTN","ISIIMP26",90,0) I DGPME'="" D "RTN","ISIIMP26",91,0) . D Q^DGPMV21 "RTN","ISIIMP26",92,0) . S ISIRC="-1^Discharge Error: "_DGPME "RTN","ISIIMP26",93,0) I ISIRC<0 D EXIT Q ISIRC "RTN","ISIIMP26",94,0) ; "RTN","ISIIMP26",95,0) D PTF^DGPMV22(DFN,DGPMDA,.DGPME,DGPMCA) ;G:$G(DGPME)]"" Q K DGPME "RTN","ISIIMP26",96,0) D:$G(DGPME)]"" "RTN","ISIIMP26",97,0) . S ISIRC="-1^Discharge Error: "_DGPME "RTN","ISIIMP26",98,0) . K DGPME "RTN","ISIIMP26",99,0) I ISIRC<0 D EXIT Q ISIRC "RTN","ISIIMP26",100,0) ; "RTN","ISIIMP26",101,0) K DGPME ; added by Lenny "RTN","ISIIMP26",102,0) I DGPMN D "RTN","ISIIMP26",103,0) . D CHK^DGPMV21 "RTN","ISIIMP26",104,0) . I $D(DGPME) D "RTN","ISIIMP26",105,0) . . S ISIRC="-1^Discharge Error: "_DGPME "RTN","ISIIMP26",106,0) . . D Q^DGPMV21 "RTN","ISIIMP26",107,0) I ISIRC<0 D EXIT Q ISIRC "RTN","ISIIMP26",108,0) K DGPME "RTN","ISIIMP26",109,0) D PTF^DGPMV21 "RTN","ISIIMP26",110,0) I $D(DGPME) D "RTN","ISIIMP26",111,0) . S ISIRC="-1^Discharge Error: PTF record is closed for this admission...cannot edit" "RTN","ISIIMP26",112,0) I ISIRC<0 D EXIT Q ISIRC "RTN","ISIIMP26",113,0) ;;; ^DGPMV3 "RTN","ISIIMP26",114,0) K ^UTILITY("DGPM",$J) "RTN","ISIIMP26",115,0) D NOW^%DTC S DGNOW=%,DGPMHY=DGPMY,DGPMOUT=0 ;G:'DGPMN DT S X=DGPMY "RTN","ISIIMP26",116,0) S X=DGPMY "RTN","ISIIMP26",117,0) S DGPM0ND=DGPMY_"^"_DGPMT_"^"_DFN_"^^^^^^^^^^^"_$S("^1^4^"[("^"_DGPMT_"^"):"",1:DGPMCA) "RTN","ISIIMP26",118,0) I DGPMT=1 S $P(DGPM0ND,"^",25)=$S(DGPMSA:1,1:0) "RTN","ISIIMP26",119,0) ;-- provider change "RTN","ISIIMP26",120,0) I DGPMT=6,$D(DGPMPC) S DGPM0ND=$$PRODAT^DGPMV3(DGPM0ND) "RTN","ISIIMP26",121,0) ; "RTN","ISIIMP26",122,0) D NEW^DGPMV3 "RTN","ISIIMP26",123,0) I Y'>0 D "RTN","ISIIMP26",124,0) . D Q^DGPMV3 "RTN","ISIIMP26",125,0) . S ISIRC="-1^Discharge Error: Error from NEW^DGPMV3" "RTN","ISIIMP26",126,0) I ISIRC<0 D EXIT Q ISIRC "RTN","ISIIMP26",127,0) S (DA,DGPMDA)=+Y "RTN","ISIIMP26",128,0) S:DGPMT=1!(DGPMT=4) DGPMCA=DA,DGPMAN=^DGPM(DA,0) D VAR^DGPMV3 ;G DR "RTN","ISIIMP26",129,0) ;;; DR^DGPMV3 "RTN","ISIIMP26",130,0) S DIE="^DGPM(" I "^1^4^6^"[("^"_DGPMT_"^"),DGPMN S DIE("NO^")="" "RTN","ISIIMP26",131,0) S DGODSPT=$S('$D(^DGPM(DGPMCA,"ODS")):0,^("ODS"):1,1:0) "RTN","ISIIMP26",132,0) ; "RTN","ISIIMP26",133,0) S DR="" "RTN","ISIIMP26",134,0) S DR=".01///"_$G(ISIMISC("dischargeDateTime")) "RTN","ISIIMP26",135,0) S DR=DR_";.04///"_$G(ISIMISC("typeOfMovement")) "RTN","ISIIMP26",136,0) ;S DR=DR_";.18///"_$G(ISIMISC("masMovementType")) "RTN","ISIIMP26",137,0) S DR=DR_";102////"_DUZ "RTN","ISIIMP26",138,0) S DR=DR_";103///NOW" "RTN","ISIIMP26",139,0) K DQ,DG D ^DIE K DIE "RTN","ISIIMP26",140,0) I $D(Y)#2 S DGPMOUT=1 "RTN","ISIIMP26",141,0) ;Modified in patch dg*5.3*692 to include privacy indicator node "DIR" "RTN","ISIIMP26",142,0) K DGZ S (^UTILITY("DGPM",$J,DGPMT,DGPMDA,"A"),DGPMA)=$S($D(^DGPM(DGPMDA,0)):^(0)_$S($G(^("DIR"))'="":U_^("DIR"),1:""),1:"") "RTN","ISIIMP26",143,0) D:DGPMT'=4 @("^DGPMV3"_DGPMT) "RTN","ISIIMP26",144,0) I DGPMA="" D "RTN","ISIIMP26",145,0) . S ISIRC="-1^Discharge Error: Incomplete discharge" "RTN","ISIIMP26",146,0) I ISIRC'=1 D EXIT Q ISIRC "RTN","ISIIMP26",147,0) S (^UTILITY("DGPM",$J,DGPMT,DGPMDA,"A"),DGPMA)=$G(^DGPM(DGPMDA,0))_$S($G(^("DIR"))'="":U_^("DIR"),1:"") I DGPMT=6 S Y=DGPMDA D AFTER^DGPMV36 "RTN","ISIIMP26",148,0) ;;; EVENTS^DGPMV3 "RTN","ISIIMP26",149,0) S DGQUIET=1 ; added by Lenny "RTN","ISIIMP26",150,0) ;;; EVENTS^DGPMV3 "RTN","ISIIMP26",151,0) I DGPMT=4!(DGPMT=5) D RESET^DGPMDDLD "RTN","ISIIMP26",152,0) I DGPMT'=4&(DGPMT'=5) D RESET^DGPMDDCN I (DGPMT'=6) D SI^DGPMV33 "RTN","ISIIMP26",153,0) D:DGPMA]"" START^DGPWB(DFN) "RTN","ISIIMP26",154,0) D EN^DGPMVBM ;notify building management if room-bed change "RTN","ISIIMP26",155,0) S DGOK=0 F I=0:0 S I=$O(^UTILITY("DGPM",$J,I)) Q:'I F J=0:0 S J=$O(^UTILITY("DGPM",$J,I,J)) Q:'J I ^(J,"A")'=^("P") S DGOK=1 Q "RTN","ISIIMP26",156,0) ;I DGOK D ^DGPMEVT ;Invoke Movement Event Driver "RTN","ISIIMP26",157,0) I DGOK K DTOUT,DIROUT "RTN","ISIIMP26",158,0) D EXIT "RTN","ISIIMP26",159,0) Q ISIRC "RTN","ISIIMP26",160,0) ; "RTN","ISIIMP26",161,0) EXIT ; "RTN","ISIIMP26",162,0) D Q^DGPMV3 "RTN","ISIIMP26",163,0) D Q^DGPMV2 "RTN","ISIIMP26",164,0) L -^DGPM("C",DFN) ; from LOCK^DGPMV1 "RTN","ISIIMP26",165,0) D KVAR^VADPT K DGPM2X,DGPMIFN,DGPMDCD,DGPMVI,DGPMY,DIE,DR,I,J,X,X1,Z "RTN","ISIIMP26",166,0) Q "RTN","ISIIMP27") 0^51^B3615 "RTN","ISIIMP27",1,0) ISIIMP27 ;ISI GROUP/MLS -- ISI DATA LOADER, (ENCOUNTERS related...) "RTN","ISIIMP27",2,0) ;;2.0;;;May 15,2014;Build 58 "RTN","ISIIMP27",3,0) ; "RTN","ISIIMP27",4,0) Q "RTN","ISIIMP27",5,0) ; "RTN","ISIIMP27",6,0) VEXAM(ISIMISC) "RTN","ISIIMP27",7,0) ; Populates V EXAM file #9000010.13 "RTN","ISIIMP27",8,0) ; INPUT DFN,VISIT_IEN,EXAM "RTN","ISIIMP27",9,0) ; "RTN","ISIIMP27",10,0) N COMMENT,ERR,EXAMIEN,EXIT,DFN,FDA,PACKAGE,VISIT,SOURCE,DATETIME "RTN","ISIIMP27",11,0) S EXIT=-1 "RTN","ISIIMP27",12,0) S ISIRC=$$VALEXAM^ISIIMPUG() ;Validate Array "RTN","ISIIMP27",13,0) Q:+ISIRC<0 ISIRC "RTN","ISIIMP27",14,0) ; "RTN","ISIIMP27",15,0) S DFN=+$G(ISIMISC("DFN")) I '$D(^DPT(DFN)) QUIT EXIT_"^ ~ Missing Patient ID, DFN" "RTN","ISIIMP27",16,0) S VISIT=+$G(ISIMISC("VISIT_IEN")) I '$D(^AUPNVSIT(VISIT)) QUIT EXIT_"^ ~ Missing or invalid Vist IEN" "RTN","ISIIMP27",17,0) S EXAMIEN=$G(ISIMISC("EXAM")) ;EXAM "RTN","ISIIMP27",18,0) I 'EXAMIEN Q EXIT_"^ ~ Missing or invalid Exam" "RTN","ISIIMP27",19,0) S DATETIME=$G(ISIMISC("DATETIME")) "RTN","ISIIMP27",20,0) S PROVIDER=$G(ISIMISC("PROVIDER")) "RTN","ISIIMP27",21,0) ; "RTN","ISIIMP27",22,0) S COMMENT=$G(ISIMISC("COMMENT")) ;FREE TEXT COMMENTS "RTN","ISIIMP27",23,0) S PACKAGE=35 ;ORDER ENTRY/RESULTS REPORTING "RTN","ISIIMP27",24,0) S SOURCE=36 ;TEXT INTEGRATION UTILITIES "RTN","ISIIMP27",25,0) ; "RTN","ISIIMP27",26,0) S FDA(9000010.13,"+1,",.01)=EXAMIEN "RTN","ISIIMP27",27,0) S FDA(9000010.13,"+1,",.02)=DFN "RTN","ISIIMP27",28,0) S FDA(9000010.13,"+1,",.03)=VISIT "RTN","ISIIMP27",29,0) S FDA(9000010.13,"+1,",1201)=DATETIME "RTN","ISIIMP27",30,0) S FDA(9000010.13,"+1,",1202)=PROVIDER "RTN","ISIIMP27",31,0) S FDA(9000010.13,"+1,",1204)=PROVIDER "RTN","ISIIMP27",32,0) S FDA(9000010.13,"+1,",81101)=COMMENT "RTN","ISIIMP27",33,0) S FDA(9000010.13,"+1,",81201)=1 ;Electronically Signed "RTN","ISIIMP27",34,0) S FDA(9000010.13,"+1,",81202)=PACKAGE "RTN","ISIIMP27",35,0) S FDA(9000010.13,"+1,",81203)=SOURCE "RTN","ISIIMP27",36,0) ; "RTN","ISIIMP27",37,0) D UPDATE^DIE("","FDA","","ERR") "RTN","ISIIMP27",38,0) I $D(ERR) QUIT "-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP27",39,0) ; "RTN","ISIIMP27",40,0) S EXIT=0 "RTN","ISIIMP27",41,0) QUIT EXIT "RTN","ISIIMP27",42,0) ; "RTN","ISIIMP27",43,0) VIMMZ(ISIMISC) "RTN","ISIIMP27",44,0) ; Populate V Immunization file "RTN","ISIIMP27",45,0) ; Required: DFN, VISIT_IEN, IZ "RTN","ISIIMP27",46,0) ; "RTN","ISIIMP27",47,0) N COMMENT,CONTRA,ERR,EXIT,DFN,FDA,IZIEN,PACKAGE,VISIT,SOURCE,DATETIME "RTN","ISIIMP27",48,0) S EXIT=-1 "RTN","ISIIMP27",49,0) ; "RTN","ISIIMP27",50,0) S ISIRC=$$VALIMZ^ISIIMPUG() ;Validate Array "RTN","ISIIMP27",51,0) Q:+ISIRC<0 ISIRC "RTN","ISIIMP27",52,0) ; "RTN","ISIIMP27",53,0) S DFN=+$G(ISIMISC("DFN")) I '$D(^DPT(DFN)) QUIT EXIT_"^ ~ Missing Patient ID, DFN" "RTN","ISIIMP27",54,0) S VISIT=+$G(ISIMISC("VISIT_IEN")) I '$D(^AUPNVSIT(VISIT)) QUIT EXIT_"^ ~ Missing or invalid Vist IEN" "RTN","ISIIMP27",55,0) S IZIEN=$G(ISIMISC("IZ")) I 'IZIEN Q EXIT_" ~ Missing or invalid Immunization" "RTN","ISIIMP27",56,0) S DATETIME=$G(ISIMISC("DATETIME")) "RTN","ISIIMP27",57,0) S PROVIDER=+$G(ISIMISC("PROVIDER")) ;I 'PROVIDER QUIT EXIT_"^ ~ Missing PROVIDER" "RTN","ISIIMP27",58,0) ; "RTN","ISIIMP27",59,0) S CONTRA=$G(ISIMISC("CONTRAINDICATED")) I CONTRA="" S CONTRA=0 "RTN","ISIIMP27",60,0) S COMMENT=$G(ISIMISC("COMMENT")) ;FREE TEXT COMMENTS "RTN","ISIIMP27",61,0) S PACKAGE=35 ;ORDER ENTRY/RESULTS REPORTING "RTN","ISIIMP27",62,0) S SOURCE=36 ;TEXT INTEGRATION UTILITIES "RTN","ISIIMP27",63,0) ; "RTN","ISIIMP27",64,0) S FDA(9000010.11,"+1,",.01)=IZIEN "RTN","ISIIMP27",65,0) S FDA(9000010.11,"+1,",.02)=DFN "RTN","ISIIMP27",66,0) S FDA(9000010.11,"+1,",.03)=VISIT "RTN","ISIIMP27",67,0) S FDA(9000010.11,"+1,",.07)=CONTRA "RTN","ISIIMP27",68,0) S FDA(9000010.11,"+1,",1201)=DATETIME "RTN","ISIIMP27",69,0) S FDA(9000010.11,"+1,",1202)=PROVIDER "RTN","ISIIMP27",70,0) S FDA(9000010.11,"+1,",1204)=PROVIDER "RTN","ISIIMP27",71,0) S FDA(9000010.11,"+1,",81101)=COMMENT "RTN","ISIIMP27",72,0) S FDA(9000010.11,"+1,",81202)=PACKAGE "RTN","ISIIMP27",73,0) S FDA(9000010.11,"+1,",81203)=SOURCE "RTN","ISIIMP27",74,0) ; "RTN","ISIIMP27",75,0) D UPDATE^DIE("","FDA","","ERR") "RTN","ISIIMP27",76,0) I $D(ERR) QUIT "-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP27",77,0) ; "RTN","ISIIMP27",78,0) S EXIT=0 "RTN","ISIIMP27",79,0) QUIT EXIT "RTN","ISIIMP27",80,0) ; "RTN","ISIIMP27",81,0) VCPT(ISIMISC) "RTN","ISIIMP27",82,0) ; "RTN","ISIIMP27",83,0) N COMMENT,CPT,DFN,EXIT,FDA,MODIFIER,MODIEN,PACKAGE,SOURCE,VISIT "RTN","ISIIMP27",84,0) N PROVIDER,PROVNARR,QUANTITY,ERR "RTN","ISIIMP27",85,0) S EXIT=-1 "RTN","ISIIMP27",86,0) ; "RTN","ISIIMP27",87,0) S ISIRC=$$VALCPT^ISIIMPUG() ;Validate Array "RTN","ISIIMP27",88,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP27",89,0) ; "RTN","ISIIMP27",90,0) S DFN=+$G(ISIMISC("DFN")) I '$D(^DPT(DFN)) QUIT EXIT_" ~ Missing Patient ID, DFN" "RTN","ISIIMP27",91,0) S VISIT=+$G(ISIMISC("VISIT_IEN")) I '$D(^AUPNVSIT(VISIT)) QUIT EXIT_" ~ Missing or invalid Vist IEN" "RTN","ISIIMP27",92,0) S CPT=$G(ISIMISC("CPT")) I 'CPT QUIT EXIT_" ~ Missing CPT code" "RTN","ISIIMP27",93,0) S PROVIDER=+$G(ISIMISC("PROVIDER")) I 'PROVIDER QUIT EXIT_"^ ~ Missing PROVIDER" "RTN","ISIIMP27",94,0) S PROVNARR=$G(ISIMISC("PROVIDER_NARRATIVE")) I 'PROVNARR QUIT EXIT_" ~ Missing Provider Narrative" "RTN","ISIIMP27",95,0) ; "RTN","ISIIMP27",96,0) S QUANTITY=1 "RTN","ISIIMP27",97,0) S COMMENT=$G(ISIMISC("COMMENT")) ;FREE TEXT COMMENTS "RTN","ISIIMP27",98,0) S PACKAGE=35 ;ORDER ENTRY/RESULTS REPORTING "RTN","ISIIMP27",99,0) S SOURCE=36 ;TEXT INTEGRATION UTILITIES "RTN","ISIIMP27",100,0) S MODIFIER=$G(ISIMISC("MODIFIER")) "RTN","ISIIMP27",101,0) ; "RTN","ISIIMP27",102,0) S FDA(9000010.18,"+1,",.01)=CPT "RTN","ISIIMP27",103,0) S FDA(9000010.18,"+1,",.02)=DFN "RTN","ISIIMP27",104,0) S FDA(9000010.18,"+1,",.03)=VISIT "RTN","ISIIMP27",105,0) S FDA(9000010.18,"+1,",.04)=PROVNARR "RTN","ISIIMP27",106,0) S FDA(9000010.18,"+1,",.16)=QUANTITY "RTN","ISIIMP27",107,0) S FDA(9000010.18,"+1,",1204)=PROVIDER "RTN","ISIIMP27",108,0) S FDA(9000010.18,"+1,",81101)=COMMENT "RTN","ISIIMP27",109,0) S FDA(9000010.18,"+1,",81202)=PACKAGE "RTN","ISIIMP27",110,0) S FDA(9000010.18,"+1,",81203)=SOURCE "RTN","ISIIMP27",111,0) I MODIFIER'="" D "RTN","ISIIMP27",112,0) . S FDA(9000010.181,"+2,","+1,",.01)=MODIFIER "RTN","ISIIMP27",113,0) ; "RTN","ISIIMP27",114,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP27",115,0) . W !,"+++FDA values+++",! "RTN","ISIIMP27",116,0) . I $D(FDA) S X="" F S X=$O(FDA(9000010.18,"+1,",X)) Q:X="" W !,"FDA(9000010.18,+1,",X,")=",FDA(9000010.18,"+1,",X) "RTN","ISIIMP27",117,0) . W !,"" R X:5 "RTN","ISIIMP27",118,0) . Q "RTN","ISIIMP27",119,0) ; "RTN","ISIIMP27",120,0) D UPDATE^DIE("","FDA","","ERR") "RTN","ISIIMP27",121,0) I $D(ERR) QUIT "-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP27",122,0) ; "RTN","ISIIMP27",123,0) S EXIT=0 "RTN","ISIIMP27",124,0) QUIT EXIT "RTN","ISIIMP27",125,0) ; "RTN","ISIIMP27",126,0) VHF(ISIMISC) ;ADD HEALTH FACTOR (#9000010.23) "RTN","ISIIMP27",127,0) ; Creates entry in #9000010.23 "RTN","ISIIMP27",128,0) ; Required Input: DFN, HFACTOR, VISIT_IEN, PROVIDER "RTN","ISIIMP27",129,0) ; "RTN","ISIIMP27",130,0) N HFACTOR,DFN,VISIT,COMMENT,PACKAGE,SOURCE,COMMENT,SEVERITY "RTN","ISIIMP27",131,0) N PROVIDER,EXIT,PROVNM,DATETIME,ERR "RTN","ISIIMP27",132,0) S ISIRC=$$VALHF^ISIIMPUG() ;Validate Array "RTN","ISIIMP27",133,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMP27",134,0) ; "RTN","ISIIMP27",135,0) S EXIT=-1 "RTN","ISIIMP27",136,0) S HFACTOR=+$G(ISIMISC("HFACTOR")) I 'HFACTOR Q EXIT_"^ Missing Health Factor" "RTN","ISIIMP27",137,0) S DFN=+$G(ISIMISC("DFN")) I '$D(^DPT(DFN)) QUIT EXIT_"^ ~ Missing Patient ID, DFN" "RTN","ISIIMP27",138,0) S VISIT=+$G(ISIMISC("VISIT_IEN")) I '$D(^AUPNVSIT(VISIT)) QUIT EXIT_"^ ~ Missing or invalid Vist IEN" "RTN","ISIIMP27",139,0) S PROVIDER=+$G(ISIMISC("PROVIDER")) I 'PROVIDER QUIT EXIT_"^ ~ Missing PROVIDER" "RTN","ISIIMP27",140,0) S DATETIME=$G(ISIMISC("DATETIME")) "RTN","ISIIMP27",141,0) S COMMENT=$G(ISIMISC("COMMENT")) ;FREE TEXT COMMENTS "RTN","ISIIMP27",142,0) S PACKAGE=35 ;ORDER ENTRY/RESULTS REPORTING "RTN","ISIIMP27",143,0) S SOURCE=36 ;TEXT INTEGRATION UTILITIES "RTN","ISIIMP27",144,0) ; "RTN","ISIIMP27",145,0) S X=$G(ISIMISC("SEVERITY")),SEVERITY=$S(X="M":X,X="MO":"MO",X="H":X,1:"M") "RTN","ISIIMP27",146,0) ; "RTN","ISIIMP27",147,0) N FDA K FDA "RTN","ISIIMP27",148,0) S FDA(9000010.23,"+1,",.01)=HFACTOR ;HEALTH FACTOR "RTN","ISIIMP27",149,0) S FDA(9000010.23,"+1,",.02)=DFN "RTN","ISIIMP27",150,0) S FDA(9000010.23,"+1,",.03)=VISIT "RTN","ISIIMP27",151,0) S FDA(9000010.23,"+1,",.04)=SEVERITY ;LEVEL/SEVERITY "RTN","ISIIMP27",152,0) S FDA(9000010.23,"+1,",1201)=DATETIME ;EVENT DATE AND TIME "RTN","ISIIMP27",153,0) S FDA(9000010.23,"+1,",1202)=PROVIDER ;ORDERING PROVIDER "RTN","ISIIMP27",154,0) S FDA(9000010.23,"+1,",1204)=PROVIDER ;ENCOUNTER PROVIDER "RTN","ISIIMP27",155,0) S FDA(9000010.23,"+1,",80101)=DATETIME ; EDITED "RTN","ISIIMP27",156,0) S FDA(9000010.23,"+1,",80102)="" ; AUDIT TRAIL "RTN","ISIIMP27",157,0) S FDA(9000010.23,"+1,",81101)=COMMENT ;COMMENTS "RTN","ISIIMP27",158,0) S FDA(9000010.23,"+1,",81201)=1 ;Electronically Signed "RTN","ISIIMP27",159,0) S FDA(9000010.23,"+1,",81202)=PACKAGE ;PACKAGE "RTN","ISIIMP27",160,0) S FDA(9000010.23,"+1,",81203)=SOURCE ;DATA SOURCE "RTN","ISIIMP27",161,0) ; "RTN","ISIIMP27",162,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP27",163,0) . W !,"+++FDA values+++",! "RTN","ISIIMP27",164,0) . I $D(FDA) S X="" F S X=$O(FDA(9000010.23,"+1,",X)) Q:X="" W !,"FDA(9000010.23,+1,",X,")=",FDA(9000010.23,"+1,",X) "RTN","ISIIMP27",165,0) . W !,"" R X:5 "RTN","ISIIMP27",166,0) . Q "RTN","ISIIMP27",167,0) D UPDATE^DIE("","FDA",,"ERR") "RTN","ISIIMP27",168,0) I $D(ERR) QUIT "-1^Fileman Error: "_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP27",169,0) S EXIT=0 "RTN","ISIIMP27",170,0) Q EXIT "RTN","ISIIMP27",171,0) ; "RTN","ISIIMP27",172,0) IVPOV(ISIMISC) "RTN","ISIIMP27",173,0) ; ***** "RTN","ISIIMP27",174,0) ; Entry point from ISIIMP07 (PROBLEM Creation) to automate V POV creation "RTN","ISIIMP27",175,0) ; If you provide the "RTN","ISIIMP27",176,0) N ISIRC S ISIRC=0 "RTN","ISIIMP27",177,0) I '$D(ISIMISC) Q "RTN","ISIIMP27",178,0) I $G(ISIMISC("ENTERED")) S ISIMISC("DATETIME")=ISIMISC("ENTERED") "RTN","ISIIMP27",179,0) S ISIMISC("ICD9")=$G(ISIMISC("ICD")) "RTN","ISIIMP27",180,0) ; DFN,PROVIDER should be set "RTN","ISIIMP27",181,0) S ISIRC=$$VPOV(.ISIMISC) "RTN","ISIIMP27",182,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMP27",183,0) . W !,"+++ IVPOV^ISIIMP27 passed from ISIIMP07+++",! "RTN","ISIIMP27",184,0) . W !,"ISIRC: ",$G(ISIRC) "RTN","ISIIMP27",185,0) . W !,"PROBIEN: ",$G(ISIMISC("PROBIEN")) "RTN","ISIIMP27",186,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC(",X,")=",ISIMISC(X) "RTN","ISIIMP27",187,0) . W !,"" R X:5 "RTN","ISIIMP27",188,0) Q "RTN","ISIIMP27",189,0) ; "RTN","ISIIMP27",190,0) VPOV(ISIMISC) "RTN","ISIIMP27",191,0) ; Populate V POV file (#9000010.07) "RTN","ISIIMP27",192,0) ; "RTN","ISIIMP27",193,0) N IICD9,COMMENT,ERR,EXIT,DFN,FDA,PACKAGE,VISIT,SOURCE,DATETIME,PRIMSEC,PROBIEN,MODIFIER "RTN","ISIIMP27",194,0) S EXIT=-1 "RTN","ISIIMP27",195,0) ; "RTN","ISIIMP27",196,0) S ISIRC=$$VALPOV^ISIIMPUG() ;Validate Array "RTN","ISIIMP27",197,0) Q:+ISIRC<0 ISIRC "RTN","ISIIMP27",198,0) ; "RTN","ISIIMP27",199,0) S DFN=$G(ISIMISC("DFN")) I '$D(^DPT(DFN)) QUIT EXIT_"^ ~ Missing Patient ID, DFN" "RTN","ISIIMP27",200,0) S VISIT=+$G(ISIMISC("VISIT_IEN")) I '$D(^AUPNVSIT(VISIT)) QUIT EXIT_"^ ~ Missing or invalid Vist IEN" "RTN","ISIIMP27",201,0) S IICD9=$G(ISIMISC("ICD9")) I '$D(^ICD9(IICD9,0)) Q "-1^Missing ICD9 IEN (#80)" "RTN","ISIIMP27",202,0) S DATETIME=$G(ISIMISC("DATETIME")) I 'DATETIME S DATETIME=$$NOW^XLFDT() "RTN","ISIIMP27",203,0) S PROVIDER=+$G(ISIMISC("PROVIDER")) ;I 'PROVIDER QUIT EXIT_"^ ~ Missing PROVIDER" "RTN","ISIIMP27",204,0) S PRIMSEC=$E($G(ISIMISC("PRIMSEC"))),PRIMSEC=$S(PRIMSEC="P":"P",PRIMSEC="S":"S",1:"P") "RTN","ISIIMP27",205,0) S MODIFIER=$G(ISIMISC("MODIFIER")) ; MODIFIER ;9000010.07,.06 MODIFIER SET (C,D,F,M,O,P,R,S,T) "RTN","ISIIMP27",206,0) S PROBIEN=+$G(ISIMISC("PROBIEN")) ;9000010.07,.16 PROBLEM LIST ENTRY -> POINTER TO PROBLEM FILE (#9000011) "RTN","ISIIMP27",207,0) I PROBIEN,'$D(^AUPNPROB(PROBIEN,0)) S PROBIEN=0 "RTN","ISIIMP27",208,0) ; "RTN","ISIIMP27",209,0) S COMMENT=$G(ISIMISC("COMMENT")) ;FREE TEXT COMMENTS "RTN","ISIIMP27",210,0) S PACKAGE=35 ;ORDER ENTRY/RESULTS REPORTING "RTN","ISIIMP27",211,0) S SOURCE=36 ;TEXT INTEGRATION UTILITIES "RTN","ISIIMP27",212,0) ; "RTN","ISIIMP27",213,0) S FDA(9000010.07,"+1,",.01)=IICD9 ;POINTER TO ICD DIAGNOSIS FILE (#80) "RTN","ISIIMP27",214,0) S FDA(9000010.07,"+1,",.02)=DFN "RTN","ISIIMP27",215,0) S FDA(9000010.07,"+1,",.03)=VISIT "RTN","ISIIMP27",216,0) I $L(MODIFIER),"|C|D|F|M|O|P|R|S|T|"[MODIFIER_"|" D "RTN","ISIIMP27",217,0) . S FDA(9000010.07,"+1,",.06)=MODIFIER "RTN","ISIIMP27",218,0) . Q "RTN","ISIIMP27",219,0) I PROBIEN S FDA(9000010.07,"+1,",.16)=PROBIEN "RTN","ISIIMP27",220,0) S FDA(9000010.07,"+1,",.12)=PRIMSEC "RTN","ISIIMP27",221,0) S FDA(9000010.07,"+1,",1201)=DATETIME "RTN","ISIIMP27",222,0) S FDA(9000010.07,"+1,",1202)=PROVIDER ;Ordering PROV "RTN","ISIIMP27",223,0) S FDA(9000010.07,"+1,",1204)=PROVIDER ;Encounter PROV "RTN","ISIIMP27",224,0) S FDA(9000010.07,"+1,",81101)=COMMENT "RTN","ISIIMP27",225,0) S FDA(9000010.07,"+1,",81202)=PACKAGE "RTN","ISIIMP27",226,0) S FDA(9000010.07,"+1,",81203)=SOURCE "RTN","ISIIMP27",227,0) ; "RTN","ISIIMP27",228,0) D UPDATE^DIE("","FDA","","ERR") "RTN","ISIIMP27",229,0) I $D(ERR) QUIT "-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP27",230,0) ; "RTN","ISIIMP27",231,0) S EXIT=0 "RTN","ISIIMP27",232,0) QUIT EXIT "RTN","ISIIMP27",233,0) ; "RTN","ISIIMP27",234,0) VPNTED(ISIMISC) "RTN","ISIIMP27",235,0) N ETOPIC,COMMENT,ERR,EXIT,DFN,FDA,PACKAGE,VISIT,SOURCE,DATETIME "RTN","ISIIMP27",236,0) S EXIT=-1 "RTN","ISIIMP27",237,0) ; "RTN","ISIIMP27",238,0) S ISIRC=$$VALVPTED^ISIIMPUG() ;Validate Array "RTN","ISIIMP27",239,0) Q:+ISIRC<0 ISIRC "RTN","ISIIMP27",240,0) ; "RTN","ISIIMP27",241,0) S DFN=$G(ISIMISC("DFN")) I '$D(^DPT(DFN)) QUIT EXIT_"^ ~ Missing Patient ID, DFN" "RTN","ISIIMP27",242,0) S VISIT=+$G(ISIMISC("VISIT_IEN")) I '$D(^AUPNVSIT(VISIT)) QUIT EXIT_"^ ~ Missing or invalid Vist IEN" "RTN","ISIIMP27",243,0) S ETOPIC=$G(ISIMISC("ED_TOPIC")) I '$D(^AUTTEDT(ETOPIC,0)) Q "-1^Missing EDUCATION TOPIC (#9999999.09)" "RTN","ISIIMP27",244,0) S DATETIME=$G(ISIMISC("DATETIME")) "RTN","ISIIMP27",245,0) S PROVIDER=+$G(ISIMISC("PROVIDER")) ;I 'PROVIDER QUIT EXIT_"^ ~ Missing PROVIDER" "RTN","ISIIMP27",246,0) S LEVEL=+$G(ISIMISC("LEVEL_OF_UNDERSTAND")) "RTN","ISIIMP27",247,0) ; "RTN","ISIIMP27",248,0) S COMMENT=$G(ISIMISC("COMMENT")) ;FREE TEXT COMMENTS "RTN","ISIIMP27",249,0) S PACKAGE=35 ;ORDER ENTRY/RESULTS REPORTING "RTN","ISIIMP27",250,0) S SOURCE=36 ;TEXT INTEGRATION UTILITIES "RTN","ISIIMP27",251,0) ; "RTN","ISIIMP27",252,0) S FDA(9000010.16,"+1,",.01)=ETOPIC ;POINTER TO EDUCATION TOPIC (#9999999.09) "RTN","ISIIMP27",253,0) S FDA(9000010.16,"+1,",.02)=DFN "RTN","ISIIMP27",254,0) S FDA(9000010.16,"+1,",.03)=VISIT "RTN","ISIIMP27",255,0) I $G(LEVEL) S FDA(9000010.16,"+1,",.06)=LEVEL ; LEVEL OF UNDERSTANDING "RTN","ISIIMP27",256,0) S FDA(9000010.16,"+1,",1201)=DATETIME "RTN","ISIIMP27",257,0) S FDA(9000010.16,"+1,",1202)=PROVIDER ;Ordering PROV "RTN","ISIIMP27",258,0) S FDA(9000010.16,"+1,",1204)=PROVIDER ;Encounter PROV "RTN","ISIIMP27",259,0) S FDA(9000010.16,"+1,",81101)=COMMENT "RTN","ISIIMP27",260,0) S FDA(9000010.16,"+1,",81202)=PACKAGE "RTN","ISIIMP27",261,0) S FDA(9000010.16,"+1,",81203)=SOURCE "RTN","ISIIMP27",262,0) ; "RTN","ISIIMP27",263,0) D UPDATE^DIE("","FDA","","ERR") "RTN","ISIIMP27",264,0) I $D(ERR) QUIT "-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP27",265,0) ; "RTN","ISIIMP27",266,0) S EXIT=0 "RTN","ISIIMP27",267,0) Q EXIT "RTN","ISIIMP27",268,0) ; "RTN","ISIIMP27",269,0) VPROV(ISIMISC) "RTN","ISIIMP27",270,0) ; 9000010.06 V PROVIDER "RTN","ISIIMP27",271,0) ; Called internally APPT^ISIIMP05 (Appointment) when Provider is given "RTN","ISIIMP27",272,0) N PROV,COMMENT,ERR,EXIT,DFN,FDA,PACKAGE,VISIT,SOURCE,DATETIME "RTN","ISIIMP27",273,0) ; "RTN","ISIIMP27",274,0) S DFN=$G(ISIMISC("DFN")) I '$D(^DPT(DFN)) QUIT EXIT_"^ ~ Missing Patient ID, DFN" "RTN","ISIIMP27",275,0) S VISIT=+$G(ISIMISC("VISIT_IEN")) I '$D(^AUPNVSIT(VISIT)) QUIT EXIT_"^ ~ Missing or invalid Vist IEN" "RTN","ISIIMP27",276,0) S PROV=$G(ISIMISC("PROVIDER")) I '$D(^VA(200,PROV,0)) Q "-1^Missing PROVIDER (#9000010.06,.01)" "RTN","ISIIMP27",277,0) S DATETIME=$G(ISIMISC("ADATE")) "RTN","ISIIMP27",278,0) S COMMENT=$G(ISIMISC("COMMENT")) ;FREE TEXT COMMENTS "RTN","ISIIMP27",279,0) S PACKAGE=35 ;ORDER ENTRY/RESULTS REPORTING "RTN","ISIIMP27",280,0) S SOURCE=36 ;TEXT INTEGRATION UTILITIES "RTN","ISIIMP27",281,0) ; "RTN","ISIIMP27",282,0) S FDA(9000010.06,"+1,",.01)=PROV "RTN","ISIIMP27",283,0) S FDA(9000010.06,"+1,",.02)=DFN "RTN","ISIIMP27",284,0) S FDA(9000010.06,"+1,",.03)=VISIT "RTN","ISIIMP27",285,0) S FDA(9000010.06,"+1,",.04)="P" ;Primary (Primary/Secondary) "RTN","ISIIMP27",286,0) S FDA(9000010.06,"+1,",.05)="A" ;Attending (Attending/Operating) "RTN","ISIIMP27",287,0) S FDA(9000010.06,"+1,",1201)=DATETIME "RTN","ISIIMP27",288,0) S FDA(9000010.06,"+1,",81101)=COMMENT "RTN","ISIIMP27",289,0) S FDA(9000010.06,"+1,",81202)=PACKAGE "RTN","ISIIMP27",290,0) S FDA(9000010.06,"+1,",81203)=SOURCE "RTN","ISIIMP27",291,0) ; "RTN","ISIIMP27",292,0) D UPDATE^DIE("","FDA","","ERR") "RTN","ISIIMP27",293,0) I $D(ERR) QUIT "-1^"_$G(ERR("DIERR",1,"TEXT",1)) "RTN","ISIIMP27",294,0) Q 1 "RTN","ISIIMPER") 0^47^B219589 "RTN","ISIIMPER",1,0) ISIIMPER ;;ISI GROUP/MLS -- ERROR PROCESSING "RTN","ISIIMPER",2,0) ;;1.0;;;Jun 26,2012;Build 58 "RTN","ISIIMPER",3,0) ; "RTN","ISIIMPER",4,0) Q "RTN","ISIIMPER",5,0) ; "RTN","ISIIMPER",6,0) ERR ; "RTN","ISIIMPER",7,0) S ISIRESUL(0)="-1^ERROR "_$$EC^%ZOSV "RTN","ISIIMPER",8,0) S (ISIRC,ISIRESUL)=ISIRESUL(0) "RTN","ISIIMPER",9,0) D @^%ZOSF("ERRTN") "RTN","ISIIMPER",10,0) Q:$Q 1 Q "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 58 "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 58 "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 58 "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 58 "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^52^B31496059 "RTN","ISIIMPL5",1,0) ISIIMPL5 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL5",2,0) ;;1.0;;;JUN 26,2012;Build 58 "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^54^B51775765 "RTN","ISIIMPL7",1,0) ISIIMPL7 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL7",2,0) ;;1.0;;;JUN 26,2012;Build 58 "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^55^B84134788 "RTN","ISIIMPL8",1,0) ISIIMPL8 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL8",2,0) ;;1.0;;;JUN 26,2012;Build 58 "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^56^B80411385 "RTN","ISIIMPL9",1,0) ISIIMPL9 ;ISI GROUP/MLS -- LAB IMPORT CONT. "RTN","ISIIMPL9",2,0) ;;1.0;;;JUN 26,2012;Build 58 "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 58 "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","ISIIMPR1",123,0) ; "RTN","ISIIMPR1",124,0) USRCREAT(ISIRESUL,MISC) "RTN","ISIIMPR1",125,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR1",126,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR1",127,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR1",128,0) ; "RTN","ISIIMPR1",129,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR1",130,0) . ;Write out input parameters "RTN","ISIIMPR1",131,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR1",132,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR1",133,0) . W !,"" R X:5 "RTN","ISIIMPR1",134,0) . Q "RTN","ISIIMPR1",135,0) ; "RTN","ISIIMPR1",136,0) D "RTN","ISIIMPR1",137,0) . S ISIRC=$$USRMISC^ISIIMPUD(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR1",138,0) . K MISC "RTN","ISIIMPR1",139,0) . S ISIRC=$$USER^ISIIMP22(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR1",140,0) . Q "RTN","ISIIMPR1",141,0) ; "RTN","ISIIMPR1",142,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" "RTN","ISIIMPR1",143,0) Q "RTN","ISIIMPR1",144,0) ; "RTN","ISIIMPR1",145,0) TMPUPDTE(ISIRESUL,MISC) "RTN","ISIIMPR1",146,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR1",147,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR1",148,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR1",149,0) ; "RTN","ISIIMPR1",150,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR1",151,0) . ;Write out input parameters "RTN","ISIIMPR1",152,0) . W !,"+++Raw MISC input params+++",! "RTN","ISIIMPR1",153,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,"MISC("_X_")="_$G(MISC(X)) "RTN","ISIIMPR1",154,0) . W !,"" R X:5 "RTN","ISIIMPR1",155,0) . Q "RTN","ISIIMPR1",156,0) ; "RTN","ISIIMPR1",157,0) D "RTN","ISIIMPR1",158,0) . S ISIRC=$$TMPMISC^ISIIMPUE(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR1",159,0) . K MISC "RTN","ISIIMPR1",160,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR1",161,0) . . W !,"+++Read ISIMISC in values+++",! "RTN","ISIIMPR1",162,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,"ISIMISC("_X_")="_$G(ISIMISC(X)) "RTN","ISIIMPR1",163,0) . . W !,"" R X:5 "RTN","ISIIMPR1",164,0) . . Q "RTN","ISIIMPR1",165,0) . S ISIRC=$$TEMPLATE^ISIIMP24(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR1",166,0) . Q "RTN","ISIIMPR1",167,0) ; "RTN","ISIIMPR1",168,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" "RTN","ISIIMPR1",169,0) Q "RTN","ISIIMPR1",170,0) ; "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 58 "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","ISIIMPR2",148,0) ; "RTN","ISIIMPR2",149,0) TMPSAVE(ISIRESUL,MISC) "RTN","ISIIMPR2",150,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR2",151,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR2",152,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR2",153,0) ; "RTN","ISIIMPR2",154,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR2",155,0) . ;Write out input parameters "RTN","ISIIMPR2",156,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR2",157,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR2",158,0) . W !,"" R X:5 "RTN","ISIIMPR2",159,0) . Q "RTN","ISIIMPR2",160,0) ; "RTN","ISIIMPR2",161,0) D "RTN","ISIIMPR2",162,0) . S ISIRC=$$TMPMISC^ISIIMPUE(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR2",163,0) . K MISC "RTN","ISIIMPR2",164,0) . S ISIRC=$$TMPSAVE^ISIIMP24(.ISIRESUL,.ISIMISC) "RTN","ISIIMPR2",165,0) . Q "RTN","ISIIMPR2",166,0) ; "RTN","ISIIMPR2",167,0) I +ISIRC<0 S ISIRESUL(0)=ISIRC ;W !,"ERROR" "RTN","ISIIMPR2",168,0) Q "RTN","ISIIMPR3") 0^57^B3189 "RTN","ISIIMPR3",1,0) ISIIMPR3 ;ISI GROUP/MLS -- ISI DATA LOADER 2.0 RPC handlers "RTN","ISIIMPR3",2,0) ;;2.0;;;May 15,2014;Build 58 "RTN","ISIIMPR3",3,0) ; "RTN","ISIIMPR3",4,0) ADMIT(ISIRESUL,MISC) "RTN","ISIIMPR3",5,0) ; "RTN","ISIIMPR3",6,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR3",7,0) N DFN,ADATE,ISIFAC,ISIWARD,ISIWARDIEN,ISIRMBD,ISIRMBDIEN,ISITYPE,ISITYPEIEN "RTN","ISIIMPR3",8,0) N ISIFTS,ISIFTSIEN,ISIMAS,ISIMASIEN,ISIPROV,ISIREG,ISIREGI,ISIFDEXC "RTN","ISIIMPR3",9,0) N ISIMISC K ISIMISC "RTN","ISIIMPR3",10,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR3",11,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR3",12,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR3",13,0) . ;Write out input parameters "RTN","ISIIMPR3",14,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR3",15,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR3",16,0) . W !,"" R X:5 "RTN","ISIIMPR3",17,0) . Q "RTN","ISIIMPR3",18,0) ; "RTN","ISIIMPR3",19,0) S ISIRC=$$ADMMISC^ISIIMPUF(.MISC,.ISIMISC) "RTN","ISIIMPR3",20,0) I (+ISIRC<0) S ISIRESUL(0)="-1^ERROR IN ADMMISC~ISIIMPUF:"_$TR(ISIRC,"^","-") Q "RTN","ISIIMPR3",21,0) ; "RTN","ISIIMPR3",22,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR3",23,0) . W !,"+++Read in values+++",! "RTN","ISIIMPR3",24,0) . I $D(PARAM) S X="" F S X=$O(PARAM(X)) Q:X="" W !,$G(PARAM(X)) "RTN","ISIIMPR3",25,0) . W !,"" R X:5 "RTN","ISIIMPR3",26,0) . Q "RTN","ISIIMPR3",27,0) K MISC "RTN","ISIIMPR3",28,0) ; "RTN","ISIIMPR3",29,0) S ISIRC=$$VALADMIT^ISIIMPUF(.ISIMISC) "RTN","ISIIMPR3",30,0) I (+ISIRC<0) S ISIRESUL(0)="-1^ERROR IN VALADMIT~ISIIMPUF:"_$TR($G(ISIRC),"^","-") Q "RTN","ISIIMPR3",31,0) ; "RTN","ISIIMPR3",32,0) S ISIRC=$$ADMIT^ISIIMP25(.ISIMISC) "RTN","ISIIMPR3",33,0) I (+ISIRC<0) S ISIRESUL(0)="-1^ERROR IN ADMIT~ISIIMP25:"_$TR($G(ISIRC),"^","-") Q "RTN","ISIIMPR3",34,0) ; "RTN","ISIIMPR3",35,0) ; Discharge if DDATE provided "RTN","ISIIMPR3",36,0) I $G(ISIMISC("DDATE"))'="" D "RTN","ISIIMPR3",37,0) . I '$$VALDSCHG^ISIIMPUF(.ISIMISC) Q "RTN","ISIIMPR3",38,0) . S ISIRC=$$DISCHARG^ISIIMP26(.ISIMISC) "RTN","ISIIMPR3",39,0) . I (+ISIRC<0) S ISIRESUL(0)="-1^DERROR IN DISCH^DGPMAPI3:"_$TR($G(ISIRC),"^","-") Q "RTN","ISIIMPR3",40,0) . S ISIRESUL(0)=1,ISIRC=1 "RTN","ISIIMPR3",41,0) . Q "RTN","ISIIMPR3",42,0) ; "RTN","ISIIMPR3",43,0) I (+ISIRC<0) Q "RTN","ISIIMPR3",44,0) S ISIRESUL(0)=1,ISIRC=1 "RTN","ISIIMPR3",45,0) Q "RTN","ISIIMPR3",46,0) ; "RTN","ISIIMPR3",47,0) HFACTOR(ISIRESUL,MISC) "RTN","ISIIMPR3",48,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR3",49,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR3",50,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR3",51,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR3",52,0) . ;Write out input parameters "RTN","ISIIMPR3",53,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR3",54,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR3",55,0) . W !,"" R X:5 "RTN","ISIIMPR3",56,0) . Q "RTN","ISIIMPR3",57,0) D "RTN","ISIIMPR3",58,0) . S ISIRC=$$ENMISC^ISIIMPUG(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR3",59,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR3",60,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR3",61,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR3",62,0) . . W !,"" R X:5 "RTN","ISIIMPR3",63,0) . . Q "RTN","ISIIMPR3",64,0) . K MISC "RTN","ISIIMPR3",65,0) . S ISIRC=$$VHF^ISIIMP27(.ISIMISC) "RTN","ISIIMPR3",66,0) . Q "RTN","ISIIMPR3",67,0) I (+ISIRC<0) S ISIRESUL(0)=ISIRC Q ;W !,"ERROR" "RTN","ISIIMPR3",68,0) S ISIRESUL(0)="1" "RTN","ISIIMPR3",69,0) Q "RTN","ISIIMPR3",70,0) ; "RTN","ISIIMPR3",71,0) VEXAM(ISIRESUL,MISC) "RTN","ISIIMPR3",72,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR3",73,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR3",74,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR3",75,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR3",76,0) . ;Write out input parameters "RTN","ISIIMPR3",77,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR3",78,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR3",79,0) . W !,"" R X:5 "RTN","ISIIMPR3",80,0) . Q "RTN","ISIIMPR3",81,0) D "RTN","ISIIMPR3",82,0) . S ISIRC=$$ENMISC^ISIIMPUG(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR3",83,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR3",84,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR3",85,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR3",86,0) . . W !,"" R X:5 "RTN","ISIIMPR3",87,0) . . Q "RTN","ISIIMPR3",88,0) . K MISC "RTN","ISIIMPR3",89,0) . S ISIRC=$$VEXAM^ISIIMP27(.ISIMISC) "RTN","ISIIMPR3",90,0) . Q "RTN","ISIIMPR3",91,0) I (+ISIRC<0) S ISIRESUL(0)=ISIRC Q ;W !,"ERROR" "RTN","ISIIMPR3",92,0) S ISIRESUL(0)="1" "RTN","ISIIMPR3",93,0) Q "RTN","ISIIMPR3",94,0) ; "RTN","ISIIMPR3",95,0) ; "RTN","ISIIMPR3",96,0) VCPT(ISIRESUL,MISC) "RTN","ISIIMPR3",97,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR3",98,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR3",99,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR3",100,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR3",101,0) . ;Write out input parameters "RTN","ISIIMPR3",102,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR3",103,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR3",104,0) . W !,"" R X:5 "RTN","ISIIMPR3",105,0) . Q "RTN","ISIIMPR3",106,0) D "RTN","ISIIMPR3",107,0) . S ISIRC=$$ENMISC^ISIIMPUG(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR3",108,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR3",109,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR3",110,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR3",111,0) . . W !,"" R X:5 "RTN","ISIIMPR3",112,0) . . Q "RTN","ISIIMPR3",113,0) . K MISC "RTN","ISIIMPR3",114,0) . S ISIRC=$$VCPT^ISIIMP27(.ISIMISC) "RTN","ISIIMPR3",115,0) . Q "RTN","ISIIMPR3",116,0) I (+ISIRC<0) S ISIRESUL(0)=ISIRC Q ;W !,"ERROR" "RTN","ISIIMPR3",117,0) S ISIRESUL(0)="1" "RTN","ISIIMPR3",118,0) Q "RTN","ISIIMPR3",119,0) ; "RTN","ISIIMPR3",120,0) VIMMZ(ISIRESUL,MISC) "RTN","ISIIMPR3",121,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR3",122,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR3",123,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR3",124,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR3",125,0) . ;Write out input parameters "RTN","ISIIMPR3",126,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR3",127,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR3",128,0) . W !,"" R X:5 "RTN","ISIIMPR3",129,0) . Q "RTN","ISIIMPR3",130,0) D "RTN","ISIIMPR3",131,0) . S ISIRC=$$ENMISC^ISIIMPUG(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR3",132,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR3",133,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR3",134,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR3",135,0) . . W !,"" R X:5 "RTN","ISIIMPR3",136,0) . . Q "RTN","ISIIMPR3",137,0) . K MISC "RTN","ISIIMPR3",138,0) . S ISIRC=$$VIMMZ^ISIIMP27(.ISIMISC) "RTN","ISIIMPR3",139,0) . Q "RTN","ISIIMPR3",140,0) I (+ISIRC<0) S ISIRESUL(0)=ISIRC Q ;W !,"ERROR" "RTN","ISIIMPR3",141,0) S ISIRESUL(0)="1" "RTN","ISIIMPR3",142,0) Q "RTN","ISIIMPR3",143,0) ; "RTN","ISIIMPR3",144,0) VPOV(ISIRESUL,MISC) "RTN","ISIIMPR3",145,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR3",146,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR3",147,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR3",148,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR3",149,0) . ;Write out input parameters "RTN","ISIIMPR3",150,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR3",151,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR3",152,0) . W !,"" R X:5 "RTN","ISIIMPR3",153,0) . Q "RTN","ISIIMPR3",154,0) D "RTN","ISIIMPR3",155,0) . S ISIRC=$$ENMISC^ISIIMPUG(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR3",156,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR3",157,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR3",158,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR3",159,0) . . W !,"" R X:5 "RTN","ISIIMPR3",160,0) . . Q "RTN","ISIIMPR3",161,0) . K MISC "RTN","ISIIMPR3",162,0) . S ISIRC=$$VPOV^ISIIMP27(.ISIMISC) "RTN","ISIIMPR3",163,0) . Q "RTN","ISIIMPR3",164,0) I (+ISIRC<0) S ISIRESUL(0)=ISIRC Q ;W !,"ERROR" "RTN","ISIIMPR3",165,0) S ISIRESUL(0)="1" "RTN","ISIIMPR3",166,0) Q "RTN","ISIIMPR3",167,0) ; "RTN","ISIIMPR3",168,0) VPTEDU(ISIRESUL,MISC) "RTN","ISIIMPR3",169,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIIMPER" "RTN","ISIIMPR3",170,0) N:'$G(ISIPARAM("DEBUG")) ISIPARAM "RTN","ISIIMPR3",171,0) K ISIRESUL S (ISIRESUL(0),ISIRC)=0 "RTN","ISIIMPR3",172,0) D:$G(ISIPARAM("DEBUG"))>0 "RTN","ISIIMPR3",173,0) . ;Write out input parameters "RTN","ISIIMPR3",174,0) . W !,"+++Raw input params+++",! "RTN","ISIIMPR3",175,0) . I $D(MISC) S X="" F S X=$O(MISC(X)) Q:X="" W !,$G(MISC(X)) "RTN","ISIIMPR3",176,0) . W !,"" R X:5 "RTN","ISIIMPR3",177,0) . Q "RTN","ISIIMPR3",178,0) D "RTN","ISIIMPR3",179,0) . S ISIRC=$$ENMISC^ISIIMPUG(.MISC,.ISIMISC) Q:ISIRC<0 "RTN","ISIIMPR3",180,0) . I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPR3",181,0) . . W !,"+++Read in values+++",! "RTN","ISIIMPR3",182,0) . . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPR3",183,0) . . W !,"" R X:5 "RTN","ISIIMPR3",184,0) . . Q "RTN","ISIIMPR3",185,0) . K MISC "RTN","ISIIMPR3",186,0) . S ISIRC=$$VPNTED^ISIIMP27(.ISIMISC) "RTN","ISIIMPR3",187,0) . Q "RTN","ISIIMPR3",188,0) I (+ISIRC<0) S ISIRESUL(0)=ISIRC Q ;W !,"ERROR" "RTN","ISIIMPR3",189,0) S ISIRESUL(0)="1" "RTN","ISIIMPR3",190,0) Q "RTN","ISIIMPR3",191,0) ; "RTN","ISIIMPT1") 0^58^B54209129 "RTN","ISIIMPT1",1,0) ISIIMPT1 ;ISI GROUP/MLS - IMPORT Unit tests "RTN","ISIIMPT1",2,0) ;;1.0;;;Jun 26,2012;Build 58 "RTN","ISIIMPT1",3,0) Q "RTN","ISIIMPT1",4,0) ; "RTN","ISIIMPT1",5,0) T1 ; "RTN","ISIIMPT1",6,0) N MISC K MISC "RTN","ISIIMPT1",7,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",8,0) S MISC("TEMPLATE")="DEFAULT" "RTN","ISIIMPT1",9,0) S MISC("IMP_TYPE")="B" "RTN","ISIIMPT1",10,0) S MISC("IMP_BATCH_NUM")="10" "RTN","ISIIMPT1",11,0) ;S MISC("TYPE")="" "RTN","ISIIMPT1",12,0) ;S MISC("NAME")="" "RTN","ISIIMPT1",13,0) S MISC("NAME_MASK")="*,TEST*" "RTN","ISIIMPT1",14,0) ;S MISC("SEX")="" "RTN","ISIIMPT1",15,0) ;S MISC("DOB")="" "RTN","ISIIMPT1",16,0) ;S MISC("LOW_DOB")="" "RTN","ISIIMPT1",17,0) ;S MISC("UP_DOB")="" "RTN","ISIIMPT1",18,0) ;S MISC("SSN")="" "RTN","ISIIMPT1",19,0) S MISC("SSN_MASK")="66666" "RTN","ISIIMPT1",20,0) ;S MISC("STREET_ADD1")="" "RTN","ISIIMPT1",21,0) ;S MISC("STREET_ADD2")="" "RTN","ISIIMPT1",22,0) ;S MISC("CITY")="" "RTN","ISIIMPT1",23,0) ;S MISC("STATE")="" "RTN","ISIIMPT1",24,0) ;S MISC("ZIP_4")="" "RTN","ISIIMPT1",25,0) ;S MISC("ZIP_4_MASK")="" "RTN","ISIIMPT1",26,0) ;S MISC("MARITAL_STATUS")="" "RTN","ISIIMPT1",27,0) ;S MISC("PH_NUM")="" "RTN","ISIIMPT1",28,0) ;S MISC("PH_NUM_MASK")="" "RTN","ISIIMPT1",29,0) S MISC("VETERAN")="N" "RTN","ISIIMPT1",30,0) D PNTIMPRT^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",31,0) Q "RTN","ISIIMPT1",32,0) T2 ; "RTN","ISIIMPT1",33,0) N MISC K MISC "RTN","ISIIMPT1",34,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",35,0) S MISC("TEMPLATE")="DEFAULT" "RTN","ISIIMPT1",36,0) S MISC("IMP_TYPE")="B" "RTN","ISIIMPT1",37,0) S MISC("IMP_BATCH_NUM")="10" "RTN","ISIIMPT1",38,0) ;S MISC("TYPE")="" "RTN","ISIIMPT1",39,0) ;S MISC("NAME")="" "RTN","ISIIMPT1",40,0) S MISC("NAME_MASK")="LAST*,FIRST*" "RTN","ISIIMPT1",41,0) ;S MISC("SEX")="" "RTN","ISIIMPT1",42,0) ;S MISC("DOB")="" "RTN","ISIIMPT1",43,0) ;S MISC("LOW_DOB")="" "RTN","ISIIMPT1",44,0) ;S MISC("UP_DOB")="" "RTN","ISIIMPT1",45,0) ;S MISC("SSN")="" "RTN","ISIIMPT1",46,0) S MISC("SSN_MASK")="66600" "RTN","ISIIMPT1",47,0) ;S MISC("STREET_ADD1")="" "RTN","ISIIMPT1",48,0) ;S MISC("STREET_ADD2")="" "RTN","ISIIMPT1",49,0) ;S MISC("CITY")="" "RTN","ISIIMPT1",50,0) ;S MISC("STATE")="" "RTN","ISIIMPT1",51,0) ;S MISC("ZIP_4")="" "RTN","ISIIMPT1",52,0) S MISC("ZIP_4_MASK")="55555" "RTN","ISIIMPT1",53,0) ;S MISC("MARITAL_STATUS")="" "RTN","ISIIMPT1",54,0) ;S MISC("PH_NUM")="" "RTN","ISIIMPT1",55,0) S MISC("PH_NUM_MASK")="555" "RTN","ISIIMPT1",56,0) S MISC("VETERAN")="N" "RTN","ISIIMPT1",57,0) D PNTIMPRT^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",58,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",59,0) Q "RTN","ISIIMPT1",60,0) T3 ; "RTN","ISIIMPT1",61,0) N MISC K MISC "RTN","ISIIMPT1",62,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",63,0) ;S MISC("TEMPLATE")="DEFAULT" "RTN","ISIIMPT1",64,0) S MISC("IMP_TYPE")="I" "RTN","ISIIMPT1",65,0) ;S MISC("IMP_BATCH_NUM")="10" "RTN","ISIIMPT1",66,0) ;S MISC("TYPE")="" "RTN","ISIIMPT1",67,0) ;S MISC("NAME")="" "RTN","ISIIMPT1",68,0) S MISC("NAME_MASK")="LAST*,FIRST*" "RTN","ISIIMPT1",69,0) ;S MISC("SEX")="" "RTN","ISIIMPT1",70,0) ;S MISC("DOB")="" "RTN","ISIIMPT1",71,0) ;S MISC("LOW_DOB")="" "RTN","ISIIMPT1",72,0) ;S MISC("UP_DOB")="" "RTN","ISIIMPT1",73,0) ;S MISC("SSN")="" "RTN","ISIIMPT1",74,0) ;S MISC("SSN_MASK")="66600" "RTN","ISIIMPT1",75,0) ;S MISC("STREET_ADD1")="" "RTN","ISIIMPT1",76,0) ;S MISC("STREET_ADD2")="" "RTN","ISIIMPT1",77,0) ;S MISC("CITY")="" "RTN","ISIIMPT1",78,0) ;S MISC("STATE")="" "RTN","ISIIMPT1",79,0) ;S MISC("ZIP_4")="" "RTN","ISIIMPT1",80,0) ;S MISC("ZIP_4_MASK")="55555" "RTN","ISIIMPT1",81,0) ;S MISC("MARITAL_STATUS")="" "RTN","ISIIMPT1",82,0) ;S MISC("PH_NUM")="" "RTN","ISIIMPT1",83,0) ;S MISC("PH_NUM_MASK")="555" "RTN","ISIIMPT1",84,0) ;S MISC("VETERAN")="N" "RTN","ISIIMPT1",85,0) D PNTIMPRT^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",86,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",87,0) Q "RTN","ISIIMPT1",88,0) T4 ; "RTN","ISIIMPT1",89,0) N MISC K MISC "RTN","ISIIMPT1",90,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",91,0) S MISC(1)="TEMPLATE^DEFAULT" "RTN","ISIIMPT1",92,0) S MISC(2)="IMP_TYPE^I" "RTN","ISIIMPT1",93,0) ;S MISC(3)="IMP_BATCH_NUM^5" "RTN","ISIIMPT1",94,0) ;S MISC(4)="DFN_NAME^Y" "RTN","ISIIMPT1",95,0) ;S MISC(5)="TYPE^" "RTN","ISIIMPT1",96,0) S MISC(6)="NAME^ZZZANOTHER,PATIENT" "RTN","ISIIMPT1",97,0) ;S MISC(7)="NAME_MASK^" "RTN","ISIIMPT1",98,0) ;S MISC(8)="SEX^" "RTN","ISIIMPT1",99,0) ;S MISC(9)="DOB^" "RTN","ISIIMPT1",100,0) S MISC(10)="LOW_DOB^1/1/1960" "RTN","ISIIMPT1",101,0) S MISC(11)="UP_DOB^1/1/1970" "RTN","ISIIMPT1",102,0) ;S MISC(12)"SSN^" "RTN","ISIIMPT1",103,0) ;S MISC(13)="SSN_MASK^66611" "RTN","ISIIMPT1",104,0) ;S MISC(14)="STREET_ADD1^" "RTN","ISIIMPT1",105,0) ;S MISC(15)="STREET_ADD2^" "RTN","ISIIMPT1",106,0) ;S MISC(16)="CITY^" "RTN","ISIIMPT1",107,0) ;S MISC(17)="STATE^" "RTN","ISIIMPT1",108,0) ;S MISC(18)="ZIP_4^" "RTN","ISIIMPT1",109,0) ;S MISC(19)="ZIP_4_MASK^55555" "RTN","ISIIMPT1",110,0) ;S MISC(20)="MARITAL_STATUS^" "RTN","ISIIMPT1",111,0) ;S MISC(21)="PH_NUM^" "RTN","ISIIMPT1",112,0) ;S MISC(22)="PH_NUM_MASK^555" "RTN","ISIIMPT1",113,0) ;S MISC(23)="VETERAN^N" "RTN","ISIIMPT1",114,0) S MISC(24)="RACE^WHITE" "RTN","ISIIMPT1",115,0) S MISC(25)="ETHNICITY^U" "RTN","ISIIMPT1",116,0) S MISC(26)="EMPLOY_STAT^EMPLOYED PART TIME" "RTN","ISIIMPT1",117,0) S MISC(27)="INSUR_TYPE^BC&BS" "RTN","ISIIMPT1",118,0) S MISC(28)="OCCUPATION^COMPUTER PROGRAMMER" "RTN","ISIIMPT1",119,0) D PNTIMPRT^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",120,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",121,0) Q "RTN","ISIIMPT1",122,0) ; "RTN","ISIIMPT1",123,0) T5 ;appointment create "RTN","ISIIMPT1",124,0) N MISC K MISC "RTN","ISIIMPT1",125,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",126,0) S MISC(1)="ADATE^DEC 3, 2014@16:00" "RTN","ISIIMPT1",127,0) S MISC(2)="CDATE^DEC 3, 2014@16:40" "RTN","ISIIMPT1",128,0) S MISC(2)="CLIN^TEST CLINIC A" "RTN","ISIIMPT1",129,0) S MISC(3)="PATIENT^666000734" "RTN","ISIIMPT1",130,0) D APPMAKE^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",131,0) ; "RTN","ISIIMPT1",132,0) W !,$G(ISIRC) "RTN","ISIIMPT1",133,0) Q "RTN","ISIIMPT1",134,0) ; "RTN","ISIIMPT1",135,0) T6 ;Problem create "RTN","ISIIMPT1",136,0) N MISC K MISC "RTN","ISIIMPT1",137,0) ;OCT 30, 1996@07:33 TWENTYEIGHT,PATIENT PRIMARY CARE "RTN","ISIIMPT1",138,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",139,0) S MISC(0)="PROBLEM^DIABETES" "RTN","ISIIMPT1",140,0) S MISC(1)="PROVIDER^PROGRAMMER,ONE" "RTN","ISIIMPT1",141,0) S MISC(2)="PAT_SSN^666000028" "RTN","ISIIMPT1",142,0) S MISC(3)="STATUS^A" "RTN","ISIIMPT1",143,0) S MISC(4)="ENTERED^OCT 30, 1996@07:33" "RTN","ISIIMPT1",144,0) S MISC(5)="ONSET^OCT 30, 1996" "RTN","ISIIMPT1",145,0) S MISC(6)="TYPE^A" "RTN","ISIIMPT1",146,0) S MISC(7)="VPOV^Y" "RTN","ISIIMPT1",147,0) D PROBMAKE^ISIIMPR1(.ISIMISC,.MISC) "RTN","ISIIMPT1",148,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",149,0) Q "RTN","ISIIMPT1",150,0) ; "RTN","ISIIMPT1",151,0) T7 ; "RTN","ISIIMPT1",152,0) S ISIMISC("PROBLEM")="DIABETES" "RTN","ISIIMPT1",153,0) D "RTN","ISIIMPT1",154,0) . S VALUE=ISIMISC("PROBLEM") "RTN","ISIIMPT1",155,0) . S (OUT,EXPIEN)="" F S EXPIEN=$O(^LEX(757.01,"B",VALUE,EXPIEN)) Q:'EXPIEN D Q:OUT=1 "RTN","ISIIMPT1",156,0) . . S EXPNM=$G(^LEX(757.01,EXPIEN,0)) Q:EXPNM="" "RTN","ISIIMPT1",157,0) . . S MAJCON=$P($G(^LEX(757.01,EXPIEN,1)),"^") Q:MAJCON="" "RTN","ISIIMPT1",158,0) . . S CODE="" F S CODE=$O(^LEX(757.02,"AMC",MAJCON,CODE)) Q:'CODE D Q:OUT=1 "RTN","ISIIMPT1",159,0) . . . S ICD=$P($G(^LEX(757.02,CODE,0)),"^",2) Q:ICD="" "RTN","ISIIMPT1",160,0) . . . S Y=$P($G(^LEX(757.03,$P($G(^LEX(757.02,CODE,0)),"^",3),0)),"^") "RTN","ISIIMPT1",161,0) . . . I Y="ICD9" S OUT=1 Q "RTN","ISIIMPT1",162,0) . . . Q "RTN","ISIIMPT1",163,0) . . Q "RTN","ISIIMPT1",164,0) . I EXPNM="" S EXIT=1 Q "RTN","ISIIMPT1",165,0) . I EXPIEN="" S EXIT=1 Q "RTN","ISIIMPT1",166,0) . I MAJCON="" S EXIT=1 Q "RTN","ISIIMPT1",167,0) . I ICD="" S EXIT=1 Q "RTN","ISIIMPT1",168,0) . S ICDIEN=$O(^ICD9("AB",ICD_" ","")) I ICDIEN="" S EXIT=1 Q "RTN","ISIIMPT1",169,0) . S ISIMISC("EXPIEN")=EXPIEN,ISIMISC("MAJCON")=MAJCON,ISIMISC("ICD")=ICD "RTN","ISIIMPT1",170,0) . S ISIMISC("ICDIEN")=ICDIEN,ISIMISC("EXPNM")=EXPNM "RTN","ISIIMPT1",171,0) . Q "RTN","ISIIMPT1",172,0) I EXIT Q "-1^Invalid data for PROBLEM" "RTN","ISIIMPT1",173,0) Q "RTN","ISIIMPT1",174,0) T8 ;Vitals unit test "RTN","ISIIMPT1",175,0) N MISC K MISC "RTN","ISIIMPT1",176,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",177,0) S MISC(1)="DT_TAKEN^7/1/12@12:00 PM" "RTN","ISIIMPT1",178,0) S MISC(2)="PAT_SSN^666000768" "RTN","ISIIMPT1",179,0) S MISC(3)="VITAL_TYPE^BP" "RTN","ISIIMPT1",180,0) S MISC(4)="RATE^172/63" "RTN","ISIIMPT1",181,0) S MISC(5)="LOCATION^PRIMARY CARE" "RTN","ISIIMPT1",182,0) S MISC(6)="ENTERED_BY^DOCTOR,ONE" "RTN","ISIIMPT1",183,0) D VITMAKE^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",184,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",185,0) Q "RTN","ISIIMPT1",186,0) ; "RTN","ISIIMPT1",187,0) T9 ;Vitals unit test 2 "RTN","ISIIMPT1",188,0) N MISC K MISC "RTN","ISIIMPT1",189,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",190,0) S MISC(1)="DT_TAKEN^6/1/2010@12:00 PM" "RTN","ISIIMPT1",191,0) S MISC(2)="PAT_SSN^666000768" "RTN","ISIIMPT1",192,0) S MISC(3)="VITAL_TYPE^PULSE" "RTN","ISIIMPT1",193,0) S MISC(4)="RATE^60" "RTN","ISIIMPT1",194,0) S MISC(5)="LOCATION^PRIMARY CARE" "RTN","ISIIMPT1",195,0) S MISC(6)="ENTERED_BY^ZZPROGRAMMER,FIVE" "RTN","ISIIMPT1",196,0) D VITMAKE^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",197,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",198,0) Q "RTN","ISIIMPT1",199,0) ; "RTN","ISIIMPT1",200,0) T10 ;Allergies unit test 1 "RTN","ISIIMPT1",201,0) N MISC K MISC "RTN","ISIIMPT1",202,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",203,0) S MISC(1)="ALLERGEN^POLLEN" "RTN","ISIIMPT1",204,0) S MISC(2)="SYMPTOM^ITCHING,WATERING EYES" "RTN","ISIIMPT1",205,0) S MISC(3)="PAT_SSN^666000892" "RTN","ISIIMPT1",206,0) S MISC(4)="ORIG_DATE^6/1/2010@12:00 PM" "RTN","ISIIMPT1",207,0) S MISC(5)="ORIGINTR^ZZPROGRAMMER,FIVE" "RTN","ISIIMPT1",208,0) S MISC(6)="HISTORIC^1" "RTN","ISIIMPT1",209,0) ;MISC(7)="OBSRV_DT^" "RTN","ISIIMPT1",210,0) D ALGMAKE^ISIIMPR2(.ISIRESUL,.MISC) "RTN","ISIIMPT1",211,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",212,0) Q "RTN","ISIIMPT1",213,0) T11 ;Allergies unit test 2 "RTN","ISIIMPT1",214,0) N MISC K MISC "RTN","ISIIMPT1",215,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",216,0) S MISC(1)="ALLERGEN^MOLD" "RTN","ISIIMPT1",217,0) S MISC(2)="SYMPTOM^RASH|ITCHING,WATERING EYES" "RTN","ISIIMPT1",218,0) S MISC(3)="PAT_SSN^666000695" "RTN","ISIIMPT1",219,0) S MISC(4)="ORIG_DATE^7/1/2010@12:00 PM" "RTN","ISIIMPT1",220,0) S MISC(5)="ORIGINTR^ZZPROGRAMMER,FIVE" "RTN","ISIIMPT1",221,0) S MISC(6)="HISTORIC^1" "RTN","ISIIMPT1",222,0) ;S MISC(7)="OBSRV_DT^7/1/2010@11:00 AM" "RTN","ISIIMPT1",223,0) D ALGMAKE^ISIIMPR2(.ISIRESUL,.MISC) "RTN","ISIIMPT1",224,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",225,0) Q "RTN","ISIIMPT1",226,0) T12 ;Laboratory testing "RTN","ISIIMPT1",227,0) ;S DUZ=97 "RTN","ISIIMPT1",228,0) ;S DUZ(0)="@" "RTN","ISIIMPT1",229,0) ;S DUZ(1)="" "RTN","ISIIMPT1",230,0) ;S DUZ(2)=1 "RTN","ISIIMPT1",231,0) ;S DUZ("AG")="E" "RTN","ISIIMPT1",232,0) ;S DUZ("BUF")=1 "RTN","ISIIMPT1",233,0) ;S DUZ("LANG")="" "RTN","ISIIMPT1",234,0) ;D ^XUP "RTN","ISIIMPT1",235,0) N MISC K MISC "RTN","ISIIMPT1",236,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",237,0) S MISC(1)="PAT_SSN^666000790" "RTN","ISIIMPT1",238,0) S MISC(2)="LAB_TEST^CHOLESTEROL" "RTN","ISIIMPT1",239,0) S MISC(3)="RESULT_DT^T-2@12:00" "RTN","ISIIMPT1",240,0) S MISC(4)="RESULT_VAL^110" "RTN","ISIIMPT1",241,0) ;S MISC(5)="ENTERED_BY^FRANK,STUART" "RTN","ISIIMPT1",242,0) S MISC(6)="LOCATION^PRIMARY CARE" "RTN","ISIIMPT1",243,0) D LABMAKE^ISIIMPR2(.ISIRESUL,.MISC) "RTN","ISIIMPT1",244,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",245,0) Q "RTN","ISIIMPT1",246,0) ; "RTN","ISIIMPT1",247,0) T13 ;User Create Testing "RTN","ISIIMPT1",248,0) S DUZ=1 "RTN","ISIIMPT1",249,0) D ^XUP "RTN","ISIIMPT1",250,0) N MISC K MISC "RTN","ISIIMPT1",251,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",252,0) S MISC(1)="TEMPLATE^DEFAULT" "RTN","ISIIMPT1",253,0) S MISC(2)="IMP_TYPE^I" "RTN","ISIIMPT1",254,0) S MISC(3)="NAME^ZZTESTEIGHT,ZZUSEREIGHT" "RTN","ISIIMPT1",255,0) ;S MISC(3)="NAME_MASK^*,TEST*" "RTN","ISIIMPT1",256,0) S MISC(4)="SEX^M" "RTN","ISIIMPT1",257,0) S MISC(5)="DOB^8/8/78" "RTN","ISIIMPT1",258,0) ;S MISC(6)="LOW_DOB^" "RTN","ISIIMPT1",259,0) ;S MISC(7)="UP_DOB^" "RTN","ISIIMPT1",260,0) ;S MISC(8)="SSN^" "RTN","ISIIMPT1",261,0) S MISC(9)="SSN_MASK^66666" "RTN","ISIIMPT1",262,0) ;S MISC(10)="STREET_ADD1^" "RTN","ISIIMPT1",263,0) ;S MISC(11)="STREET_ADD2")="" "RTN","ISIIMPT1",264,0) ;S MISC(12)="CITY^" "RTN","ISIIMPT1",265,0) ;S MISC(13)="STATE^" "RTN","ISIIMPT1",266,0) ;S MISC(14)="ZIP_4^" "RTN","ISIIMPT1",267,0) ;S MISC(15)="ZIP_4_MASK^" "RTN","ISIIMPT1",268,0) ;S MISC(16)="MARITAL_STATUS^" "RTN","ISIIMPT1",269,0) ;S MISC(17)="PH_NUM^" "RTN","ISIIMPT1",270,0) ;S MISC(18)="PH_NUM_MASK^" "RTN","ISIIMPT1",271,0) ;S MISC(19)="EMAIL^ZZTHREE.ZZTEST@GMAIL.COM" "RTN","ISIIMPT1",272,0) ;S MISC(20)="SERVICE^" "RTN","ISIIMPT1",273,0) S MISC(21)="MRG_SOURCE^1" "RTN","ISIIMPT1",274,0) ;S MISC(22)="TERM_DATE^" "RTN","ISIIMPT1",275,0) D USRCREAT^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",276,0) W ! ;ZW ISIRESUL "RTN","ISIIMPT1",277,0) Q "RTN","ISIIMPT1",278,0) ; "RTN","ISIIMPT1",279,0) T14 ;User batch creation testing "RTN","ISIIMPT1",280,0) ; "RTN","ISIIMPT1",281,0) S DUZ=1 "RTN","ISIIMPT1",282,0) D ^XUP "RTN","ISIIMPT1",283,0) N MISC K MISC "RTN","ISIIMPT1",284,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",285,0) S MISC(1)="TEMPLATE^DEFAULT" "RTN","ISIIMPT1",286,0) S MISC(2)="IMP_TYPE^B" "RTN","ISIIMPT1",287,0) S MISC(3)="IMP_BATCH_NUM^2" "RTN","ISIIMPT1",288,0) S MISC(4)="DFN_NAME^Y" "RTN","ISIIMPT1",289,0) S MISC(5)="NAME_MASK^*ZZZSTARK,ZZSTARK" "RTN","ISIIMPT1",290,0) ;S MISC(6)="SEX^M" "RTN","ISIIMPT1",291,0) ;S MISC(7)="DOB^8/8/78" "RTN","ISIIMPT1",292,0) S MISC(8)="LOW_DOB^1/1/1960" "RTN","ISIIMPT1",293,0) S MISC(9)="UP_DOB^1/1/1980" "RTN","ISIIMPT1",294,0) ;S MISC(10)="SSN^" "RTN","ISIIMPT1",295,0) S MISC(11)="SSN_MASK^666" "RTN","ISIIMPT1",296,0) S MISC(12)="MRG_SOURCE^1" "RTN","ISIIMPT1",297,0) D USRCREAT^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",298,0) W ! ;ZW ISIRESUL "RTN","ISIIMPT1",299,0) Q "RTN","ISIIMPT1",300,0) ; "RTN","ISIIMPT1",301,0) T15 "RTN","ISIIMPT1",302,0) ; "RTN","ISIIMPT1",303,0) S DUZ=1 "RTN","ISIIMPT1",304,0) D ^XUP "RTN","ISIIMPT1",305,0) N MISC K MISC "RTN","ISIIMPT1",306,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",307,0) D TEMPLATE^ISIIMPUA(.ISIRESUL) "RTN","ISIIMPT1",308,0) W ! ;ZW ISIRESUL "RTN","ISIIMPT1",309,0) Q "RTN","ISIIMPT1",310,0) ; "RTN","ISIIMPT1",311,0) T16 ; "RTN","ISIIMPT1",312,0) ; UNIT TEST for HEALTH FACTOR ADD "RTN","ISIIMPT1",313,0) ; "RTN","ISIIMPT1",314,0) K MISC "RTN","ISIIMPT1",315,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",316,0) S MISC(1)="PAT_SSN^666000011" "RTN","ISIIMPT1",317,0) S MISC(2)="HFACTOR^PHYSICAL LIMITATIONS" "RTN","ISIIMPT1",318,0) S MISC(3)="PROVIDER^PROGRAMMER,ONE" "RTN","ISIIMPT1",319,0) S MISC(4)="DATETIME^11/21/1996@0800" "RTN","ISIIMPT1",320,0) S MISC(5)="COMMENT^This is a test." "RTN","ISIIMPT1",321,0) ;S MISC(6)="SEVERITY^" "RTN","ISIIMPT1",322,0) ; "RTN","ISIIMPT1",323,0) D HFACTOR^ISIIMPR3(.ISIRESUL,.MISC) "RTN","ISIIMPT1",324,0) "RTN","ISIIMPT1",325,0) W !,"ISIRESUL:",! ;ZW ISIRESUL "RTN","ISIIMPT1",326,0) W !,"ISIRC:",$G(ISIRC) "RTN","ISIIMPT1",327,0) ; "RTN","ISIIMPT1",328,0) Q "RTN","ISIIMPT1",329,0) ; "RTN","ISIIMPT1",330,0) T17 ; Unit test for V IMMUNIZATION "RTN","ISIIMPT1",331,0) K MISC "RTN","ISIIMPT1",332,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",333,0) S MISC(1)="PAT_SSN^666000011" "RTN","ISIIMPT1",334,0) S MISC(2)="IZ^FLU SHOT" "RTN","ISIIMPT1",335,0) S MISC(3)="PROVIDER^PROGRAMMER,ONE" "RTN","ISIIMPT1",336,0) S MISC(4)="DATETIME^11/21/1996@0800" "RTN","ISIIMPT1",337,0) S MISC(5)="COMMENT^This is a test." "RTN","ISIIMPT1",338,0) ; "RTN","ISIIMPT1",339,0) D VIMMZ^ISIIMPR3(.ISIRESUL,.MISC) "RTN","ISIIMPT1",340,0) ; "RTN","ISIIMPT1",341,0) W !,"ISIRESUL:",! ;ZW ISIRESUL "RTN","ISIIMPT1",342,0) W !,"ISIRC:",$G(ISIRC) "RTN","ISIIMPT1",343,0) Q "RTN","ISIIMPT1",344,0) ; "RTN","ISIIMPT1",345,0) T18 ; Unit test for V CPT "RTN","ISIIMPT1",346,0) K MISC,ISIMISC,ISIRESUL "RTN","ISIIMPT1",347,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",348,0) S MISC(1)="PAT_SSN^666000011" "RTN","ISIIMPT1",349,0) S MISC(2)="CPT^99201" "RTN","ISIIMPT1",350,0) S MISC(3)="PROVIDER_NARRATIVE^this guy's a little sick" "RTN","ISIIMPT1",351,0) S MISC(4)="PROVIDER^PROGRAMMER,ONE" "RTN","ISIIMPT1",352,0) S MISC(5)="DATETIME^11/21/1996@0800" "RTN","ISIIMPT1",353,0) S MISC(6)="COMMENT^This is a test." "RTN","ISIIMPT1",354,0) D VCPT^ISIIMPR3(.ISIRESUL,.MISC) "RTN","ISIIMPT1",355,0) W !,"ISIRESUL:",! ;ZW ISIRESUL "RTN","ISIIMPT1",356,0) W !,"ISIRC:",$G(ISIRC) "RTN","ISIIMPT1",357,0) Q "RTN","ISIIMPT1",358,0) ; "RTN","ISIIMPT1",359,0) T19 ;Unit Test for V EXAM "RTN","ISIIMPT1",360,0) ; "RTN","ISIIMPT1",361,0) K MISC,ISIMISC,ISIRESUL "RTN","ISIIMPT1",362,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",363,0) S MISC(1)="PAT_SSN^666000011" "RTN","ISIIMPT1",364,0) S MISC(2)="EXAM^DIABETIC FOOT SENSATION" "RTN","ISIIMPT1",365,0) S MISC(3)="PROVIDER^PROGRAMMER,ONE" "RTN","ISIIMPT1",366,0) S MISC(4)="DATETIME^11/21/1996@0800" "RTN","ISIIMPT1",367,0) ;S MISC(5)="COMMENT^This is a test." "RTN","ISIIMPT1",368,0) D VEXAM^ISIIMPR3(.ISIRESUL,.MISC) "RTN","ISIIMPT1",369,0) W !,"ISIRESUL:",! ;ZW ISIRESUL "RTN","ISIIMPT1",370,0) W !,"ISIRC:",$G(ISIRC) "RTN","ISIIMPT1",371,0) Q "RTN","ISIIMPT1",372,0) ; "RTN","ISIIMPT1",373,0) T20 ;unit test for Radiology "RTN","ISIIMPT1",374,0) K MISC,ISIMISC,ISIRESUL "RTN","ISIIMPT1",375,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",376,0) S MISC(1)="PAT_SSN^666000793" "RTN","ISIIMPT1",377,0) S MISC(2)="RAPROC^KNEE 2 VIEWS" "RTN","ISIIMPT1",378,0) S MISC(3)="MAGLOC^RADIOLOGY MAIN FLOOR" "RTN","ISIIMPT1",379,0) S MISC(4)="PROV^PROGRAMMER,ONE" "RTN","ISIIMPT1",380,0) S MISC(5)="RADTE^09/09/2014@1200" "RTN","ISIIMPT1",381,0) S MISC(6)="REQLOC^PRIMARY CARE" "RTN","ISIIMPT1",382,0) S MISC(7)="REASON^Diagnostic Study." "RTN","ISIIMPT1",383,0) S MISC(8)="HISTORY^VTE Confirmed." "RTN","ISIIMPT1",384,0) S MISC(9)="TECH^PROGRAMMER,ONE" "RTN","ISIIMPT1",385,0) S MISC(10)="TECHCOMM^VTE" "RTN","ISIIMPT1",386,0) D RADOMAKE^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",387,0) W !,"ISIRESUL:",! ;ZW ISIRESUL "RTN","ISIIMPT1",388,0) W !,"ISIRC:",$G(ISIRC) "RTN","ISIIMPT1",389,0) Q "RTN","ISIIMPT1",390,0) ; "RTN","ISIIMPT1",391,0) T21 ;Unit Test for V PATIENT ED "RTN","ISIIMPT1",392,0) N MISC K MISC "RTN","ISIIMPT1",393,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",394,0) S MISC(1)="PROVIDER^PROGRAMMER,ONE" "RTN","ISIIMPT1",395,0) S MISC(2)="PAT_SSN^666000011" "RTN","ISIIMPT1",396,0) S MISC(3)="DATETIME^11/21/1996@0800" "RTN","ISIIMPT1",397,0) S MISC(4)="COMMENT^This is a test." "RTN","ISIIMPT1",398,0) S MISC(5)="ED_TOPIC^02-DIABETES EDUCATION" "RTN","ISIIMPT1",399,0) D VPTEDU^ISIIMPR3(.ISIMISC,.MISC) "RTN","ISIIMPT1",400,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",401,0) Q "RTN","ISIIMPT1",402,0) ; "RTN","ISIIMPT1",403,0) T22 ;Unit Test for V POV "RTN","ISIIMPT1",404,0) ;MAY 21, 2000@10:02 THIRTYSIX,PATIENT PRIMARY CARE "RTN","ISIIMPT1",405,0) N MISC K MISC "RTN","ISIIMPT1",406,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",407,0) S MISC(1)="PROVIDER^PROGRAMMER,ONE" "RTN","ISIIMPT1",408,0) S MISC(2)="PAT_SSN^666000036" "RTN","ISIIMPT1",409,0) S MISC(3)="DATETIME^MAY 21, 2000@10:02" "RTN","ISIIMPT1",410,0) S MISC(4)="COMMENT^This is a test." "RTN","ISIIMPT1",411,0) S MISC(5)="ICD9^250.00" "RTN","ISIIMPT1",412,0) D VPOV^ISIIMPR3(.ISIMISC,.MISC) "RTN","ISIIMPT1",413,0) W !,ISIRC,! ;ZW ISIRESUL "RTN","ISIIMPT1",414,0) Q "RTN","ISIIMPT1",415,0) ; "RTN","ISIIMPT1",416,0) T23 ;unit test for template save "RTN","ISIIMPT1",417,0) ; "RTN","ISIIMPT1",418,0) K MISC "RTN","ISIIMPT1",419,0) S ISIPARAM("DEBUG")=1 "RTN","ISIIMPT1",420,0) S MISC(0)="NAME^DEFAULT" "RTN","ISIIMPT1",421,0) S MISC(1)="TYPE^NON-VETERAN (OTHER)" "RTN","ISIIMPT1",422,0) S MISC(2)="NAME_MASK^*,PATIENT" "RTN","ISIIMPT1",423,0) S MISC(3)="SSN_MASK^666" "RTN","ISIIMPT1",424,0) S MISC(4)="SEX^" "RTN","ISIIMPT1",425,0) S MISC(5)="EDOB^JAN 01, 1929" "RTN","ISIIMPT1",426,0) S MISC(6)="LDOB^MAY 24, 2012" "RTN","ISIIMPT1",427,0) S MISC(7)="MARITAL_STATUS^" "RTN","ISIIMPT1",428,0) S MISC(8)="ZIP_MASK^99999" "RTN","ISIIMPT1",429,0) S MISC(9)="PH_NUM^999" "RTN","ISIIMPT1",430,0) S MISC(10)="CITY^" "RTN","ISIIMPT1",431,0) S MISC(11)="STATE^" "RTN","ISIIMPT1",432,0) S MISC(12)="VETERAN^NO" "RTN","ISIIMPT1",433,0) S MISC(13)="DFN_NAME^N" "RTN","ISIIMPT1",434,0) S MISC(14)="EMPLOY_STAT^" "RTN","ISIIMPT1",435,0) S MISC(15)="SERVICE^MEDICAL ADMINISTRATION" "RTN","ISIIMPT1",436,0) S MISC(16)="EMAIL_MASK^HOSPITAL.NET" "RTN","ISIIMPT1",437,0) S MISC(17)="USER_MASK^*,ZZUSERTEST" "RTN","ISIIMPT1",438,0) S MISC(18)="ESIG_APND^11" "RTN","ISIIMPT1",439,0) S MISC(19)="ACCESS_APND^1" "RTN","ISIIMPT1",440,0) S MISC(20)="VERIFY_APND^1." "RTN","ISIIMPT1",441,0) D TMPUPDTE^ISIIMPR1(.ISIRESUL,.MISC) "RTN","ISIIMPT1",442,0) W !,ISIRC,! "RTN","ISIIMPT1",443,0) Q "RTN","ISIIMPU1") 0^8^B153268143 "RTN","ISIIMPU1",1,0) ISIIMPU1 ;ISI GROUP/MLS -- Patient Import Utility "RTN","ISIIMPU1",2,0) ;;1.0;;;Jun 26,2012;Build 58 "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) ;;MRG_SOURCE |FIELD |.01 |Patient to merge profile from "RTN","ISIIMPU1",52,0) Q "RTN","ISIIMPU1",53,0) ; "RTN","ISIIMPU1",54,0) PNTMISC(MISC,ISIMISC) "RTN","ISIIMPU1",55,0) ; "RTN","ISIIMPU1",56,0) ;INPUT: "RTN","ISIIMPU1",57,0) ; MISC - raw list values from RPC client "RTN","ISIIMPU1",58,0) ; "RTN","ISIIMPU1",59,0) ;OUTPUT: "RTN","ISIIMPU1",60,0) ; ISIMISC - indexed values for pnt create/import use "RTN","ISIIMPU1",61,0) ; "RTN","ISIIMPU1",62,0) N MISCDEF "RTN","ISIIMPU1",63,0) K ISIMISC "RTN","ISIIMPU1",64,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU1",65,0) S ISIRC=$$PNTMISC1("ISIMISC") "RTN","ISIIMPU1",66,0) Q ISIRC "RTN","ISIIMPU1",67,0) ; "RTN","ISIIMPU1",68,0) PNTMISC1(DSTNODE) "RTN","ISIIMPU1",69,0) N RETURN,ERRCNT,I,EXIT,PARAM,VALUE,TMPL,IENS,TYPE,FIELD,DATE,RESULT,MSG "RTN","ISIIMPU1",70,0) S (EXIT,TMPL,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPU1",71,0) F S I=$O(MISC(I)) Q:I="" D Q:EXIT "RTN","ISIIMPU1",72,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPU1",73,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPU1",74,0) . ; Process TEMPLATE first, then overlay with passed params "RTN","ISIIMPU1",75,0) . I PARAM="TEMPLATE" D "RTN","ISIIMPU1",76,0) . . I VALUE="" S ISIRC="-1^Invalid TEMPLATE name",EXIT=1 Q "RTN","ISIIMPU1",77,0) . . I '$D(^ISI(9001,"B",VALUE)) S ISIRC="-1^Invalid TEMPLATE name",EXIT=1 Q "RTN","ISIIMPU1",78,0) . . D TEMPLATE "RTN","ISIIMPU1",79,0) . . Q "RTN","ISIIMPU1",80,0) . I EXIT=1 Q "RTN","ISIIMPU1",81,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed",EXIT=1 Q "RTN","ISIIMPU1",82,0) . S TYPE=$P(MISCDEF(PARAM),"|"),FIELD=$P(MISCDEF(PARAM),"|",2) "RTN","ISIIMPU1",83,0) . I PARAM="TEMPLATE" Q ;already processed "RTN","ISIIMPU1",84,0) . I PARAM["DOB" D "RTN","ISIIMPU1",85,0) . . S DATE=VALUE D DT^DILF("",DATE,.RESULT,"",.MSG) "RTN","ISIIMPU1",86,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid date value in DOB, LO_DOB, or UP_DOB field" Q "RTN","ISIIMPU1",87,0) . . S VALUE=RESULT "RTN","ISIIMPU1",88,0) . I TYPE="FIELD" D "RTN","ISIIMPU1",89,0) . . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU1",90,0) . . Q "RTN","ISIIMPU1",91,0) . I TYPE="PARAM" D "RTN","ISIIMPU1",92,0) . . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU1",93,0) . . Q "RTN","ISIIMPU1",94,0) . I TYPE="MASK" D "RTN","ISIIMPU1",95,0) . . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU1",96,0) . . Q "RTN","ISIIMPU1",97,0) . Q "RTN","ISIIMPU1",98,0) Q ISIRC "RTN","ISIIMPU1",99,0) ; "RTN","ISIIMPU1",100,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPU1",101,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPU1",102,0) K MISCDEF "RTN","ISIIMPU1",103,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPU1",104,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPU1",105,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPU1",106,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPU1",107,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPU1",108,0) Q "RTN","ISIIMPU1",109,0) ; "RTN","ISIIMPU1",110,0) TEMPLATE "RTN","ISIIMPU1",111,0) N ARRAY,MSG "RTN","ISIIMPU1",112,0) S IENS=$O(^ISI(9001,"B",VALUE,""))_"," "RTN","ISIIMPU1",113,0) D GETS^DIQ(9001,IENS,"*","IE","ARRAY","MSG") "RTN","ISIIMPU1",114,0) I $G(DIERR) S ISIRC=-1,EXIT=1 Q "RTN","ISIIMPU1",115,0) S @DSTNODE@("TYPE")=ARRAY(9001,IENS,1,"E") "RTN","ISIIMPU1",116,0) S @DSTNODE@("NAME_MASK")=ARRAY(9001,IENS,2,"E") "RTN","ISIIMPU1",117,0) S @DSTNODE@("SSN_MASK")=ARRAY(9001,IENS,4,"E") "RTN","ISIIMPU1",118,0) S @DSTNODE@("SEX")=ARRAY(9001,IENS,5,"E") "RTN","ISIIMPU1",119,0) S @DSTNODE@("LOW_DOB")=ARRAY(9001,IENS,6,"E") "RTN","ISIIMPU1",120,0) S @DSTNODE@("UP_DOB")=ARRAY(9001,IENS,7,"E") "RTN","ISIIMPU1",121,0) S @DSTNODE@("MARITAL_STATUS")=ARRAY(9001,IENS,8,"E") "RTN","ISIIMPU1",122,0) S @DSTNODE@("ZIP_4_MASK")=ARRAY(9001,IENS,9,"E") "RTN","ISIIMPU1",123,0) S @DSTNODE@("PH_NUM_MASK")=ARRAY(9001,IENS,10,"E") "RTN","ISIIMPU1",124,0) S @DSTNODE@("CITY")=ARRAY(9001,IENS,11,"E") "RTN","ISIIMPU1",125,0) S @DSTNODE@("STATE")=ARRAY(9001,IENS,12,"E") "RTN","ISIIMPU1",126,0) S @DSTNODE@("VETERAN")=ARRAY(9001,IENS,13,"E") "RTN","ISIIMPU1",127,0) S @DSTNODE@("DFN_NAME")=ARRAY(9001,IENS,14,"E") "RTN","ISIIMPU1",128,0) S @DSTNODE@("EMPLOY_STAT")=ARRAY(9001,IENS,15,"E") "RTN","ISIIMPU1",129,0) Q "RTN","ISIIMPU1",130,0) ; "RTN","ISIIMPU1",131,0) VALIDATE(ISIMISC) "RTN","ISIIMPU1",132,0) ; Entry point to Validate content of patient create/array "RTN","ISIIMPU1",133,0) ; "RTN","ISIIMPU1",134,0) ; Input - ISIMISC(ARRAY) "RTN","ISIIMPU1",135,0) ; Format: ISIMISC(PARAM)=VALUE "RTN","ISIIMPU1",136,0) ; eg: ISIMISC("NAME")="FIRST,LAST" "RTN","ISIIMPU1",137,0) ; "RTN","ISIIMPU1",138,0) ; Output - ISIRC [return code] "RTN","ISIIMPU1",139,0) N FILE,FIELD,FLAG,VALUE,RESULT,MSG,MISCDEF,EXIT,Y "RTN","ISIIMPU1",140,0) S EXIT=0,FILE=2,FLAG="" S ISIRC=0 "RTN","ISIIMPU1",141,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU1",142,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMPU1",143,0) ; "RTN","ISIIMPU1",144,0) ;-- IMP_TYPE -- "RTN","ISIIMPU1",145,0) I $G(ISIMISC("IMP_TYPE"))="" Q "-1^Missing IMP_TYPE" "RTN","ISIIMPU1",146,0) S ISIMISC("IMP_TYPE")=$TR(ISIMISC("IMP_TYPE"),"bi","BI") I $L(ISIMISC("IMP_TYPE"))'=1 Q "-1^Invalid IMP_TYPE" "RTN","ISIIMPU1",147,0) I ("BI"'[ISIMISC("IMP_TYPE")&(ISIMISC("IMP_TYPE")?1A)) Q "-1^Invalid IMP_TYPE" "RTN","ISIIMPU1",148,0) ; "RTN","ISIIMPU1",149,0) ;-- IMP_BATCH_NUM -- "RTN","ISIIMPU1",150,0) I (ISIMISC("IMP_TYPE")="B"&'($G(ISIMISC("IMP_BATCH_NUM"))?1N.N)) Q "-1^Invalid IMP_BATCH_NUM" "RTN","ISIIMPU1",151,0) ; "RTN","ISIIMPU1",152,0) ;-- DFN_NAME -- "RTN","ISIIMPU1",153,0) I $G(ISIMISC("DFN_NAME"))'="" D "RTN","ISIIMPU1",154,0) . S ISIMISC("DFN_NAME")=$E(ISIMISC("DFN_NAME")) "RTN","ISIIMPU1",155,0) . S ISIMISC("DFN_NAME")=$TR(ISIMISC("DFN_NAME"),"yn","YN") "RTN","ISIIMPU1",156,0) . I "YN"'[ISIMISC("DFN_NAME") S EXIT=1 Q "RTN","ISIIMPU1",157,0) . Q "RTN","ISIIMPU1",158,0) Q:EXIT "-1^Invalid DFN_NAME ('Y' or 'N')" "RTN","ISIIMPU1",159,0) ; "RTN","ISIIMPU1",160,0) ;-- TYPE -- "RTN","ISIIMPU1",161,0) I $G(ISIMISC("TYPE"))="" S ISIMISC("TYPE")="NON-VETERAN (OTHER)" "RTN","ISIIMPU1",162,0) S FILE="2",FIELD="391",FLAG="",VALUE=ISIMISC("TYPE") "RTN","ISIIMPU1",163,0) D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) "RTN","ISIIMPU1",164,0) Q:'(+RESULT) "-1^Invalid PATIENT TYPE (#2,391)" "RTN","ISIIMPU1",165,0) I RESULT S ISIMISC("TYPE")=RESULT "RTN","ISIIMPU1",166,0) ; "RTN","ISIIMPU1",167,0) ;-- NAME -- "RTN","ISIIMPU1",168,0) I $G(ISIMISC("NAME"))'="" D "RTN","ISIIMPU1",169,0) . S FIELD=$P(MISCDEF("NAME"),"|",2),VALUE=ISIMISC("NAME"),ISIMISC("NAME")=$$UP^XLFSTR(VALUE) "RTN","ISIIMPU1",170,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",171,0) . Q "RTN","ISIIMPU1",172,0) Q:EXIT "-1^Invalid NAME (#2,.01)" "RTN","ISIIMPU1",173,0) ; "RTN","ISIIMPU1",174,0) ;-- NAME_MASK -- "RTN","ISIIMPU1",175,0) I $G(ISIMISC("NAME_MASK"))=""&($G(ISIMISC("NAME"))="") Q "-1^Must have either NAME or NAME_MASK" "RTN","ISIIMPU1",176,0) ; "RTN","ISIIMPU1",177,0) ;-- SEX -- "RTN","ISIIMPU1",178,0) I $G(ISIMISC("SEX"))'="" D "RTN","ISIIMPU1",179,0) . S FIELD=$P(MISCDEF("SEX"),"|",2),VALUE=ISIMISC("SEX") "RTN","ISIIMPU1",180,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",181,0) . S ISIMISC("SEX")=RESULT "RTN","ISIIMPU1",182,0) . Q "RTN","ISIIMPU1",183,0) Q:EXIT "-1^Invalid SEX (#2,.02)" "RTN","ISIIMPU1",184,0) ; "RTN","ISIIMPU1",185,0) ;-- DOB -- "RTN","ISIIMPU1",186,0) I $G(ISIMISC("DOB"))'="" D "RTN","ISIIMPU1",187,0) . S FIELD=$P(MISCDEF("DOB"),"|",2),VALUE=ISIMISC("DOB") "RTN","ISIIMPU1",188,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU1",189,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",190,0) . Q "RTN","ISIIMPU1",191,0) Q:EXIT "-1^Invalid DOB (#2,.03)" "RTN","ISIIMPU1",192,0) ; "RTN","ISIIMPU1",193,0) ;-- LOW_DOB -- "RTN","ISIIMPU1",194,0) I $G(ISIMISC("LOW_DOB"))'="" D "RTN","ISIIMPU1",195,0) . S FIELD=$P(MISCDEF("LOW_DOB"),"|",2),VALUE=ISIMISC("LOW_DOB") "RTN","ISIIMPU1",196,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU1",197,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",198,0) . I $G(ISIMISC("UP_DOB"))'="" D "RTN","ISIIMPU1",199,0) . . I ISIMISC("LOW_DOB")>ISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPU1",200,0) . Q "RTN","ISIIMPU1",201,0) Q:EXIT "-1^Invalid LOW_DOB (#2,.03)" "RTN","ISIIMPU1",202,0) ; "RTN","ISIIMPU1",203,0) ;-- UP_DOB -- "RTN","ISIIMPU1",204,0) I $G(ISIMISC("UP_DOB"))'="" D "RTN","ISIIMPU1",205,0) . S FIELD=$P(MISCDEF("UP_DOB"),"|",2),VALUE=ISIMISC("UP_DOB") "RTN","ISIIMPU1",206,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU1",207,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",208,0) . I $G(ISIMISC("LOW_DOB"))'="" D "RTN","ISIIMPU1",209,0) . . I ISIMISC("LOW_DOB")>ISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPU1",210,0) . . Q "RTN","ISIIMPU1",211,0) . Q "RTN","ISIIMPU1",212,0) Q:EXIT "-1^Invalid UP_DOB (#2,.03)" "RTN","ISIIMPU1",213,0) ; "RTN","ISIIMPU1",214,0) ;--MARITAL_STATUS-- "RTN","ISIIMPU1",215,0) I $G(ISIMISC("MARITAL_STATUS"))'="" D "RTN","ISIIMPU1",216,0) . S FIELD=$P(MISCDEF("MARITAL_STATUS"),"|",2),VALUE=ISIMISC("MARITAL_STATUS") "RTN","ISIIMPU1",217,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",218,0) . I RESULT S ISIMISC("MARITAL_STATUS")=RESULT "RTN","ISIIMPU1",219,0) . Q "RTN","ISIIMPU1",220,0) Q:EXIT "-1^Invalid MARITAL_STATUS (#2,.05)" "RTN","ISIIMPU1",221,0) ; "RTN","ISIIMPU1",222,0) ;OCCUPATION "RTN","ISIIMPU1",223,0) I $G(ISIMISC("OCCUPATION"))'="" D "RTN","ISIIMPU1",224,0) . S FIELD=$P(MISCDEF("OCCUPATION"),"|",2),VALUE=ISIMISC("OCCUPATION") "RTN","ISIIMPU1",225,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",226,0) . Q "RTN","ISIIMPU1",227,0) Q:EXIT "-1^Invalid OCCUPATION (#2,.07)" "RTN","ISIIMPU1",228,0) ; "RTN","ISIIMPU1",229,0) ;-- RACE -- "RTN","ISIIMPU1",230,0) I $G(ISIMISC("RACE"))'="" D "RTN","ISIIMPU1",231,0) . S FIELD=$P(MISCDEF("RACE"),"|",2) "RTN","ISIIMPU1",232,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) ;race information is multiple "RTN","ISIIMPU1",233,0) . S VALUE=ISIMISC("RACE") "RTN","ISIIMPU1",234,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",235,0) . S FILE=2 ;set back to default "RTN","ISIIMPU1",236,0) . I RESULT S ISIMISC("RACE")=RESULT "RTN","ISIIMPU1",237,0) . Q "RTN","ISIIMPU1",238,0) Q:EXIT "-1^Invalid RACE INFORMATION (#2.02,.01)" "RTN","ISIIMPU1",239,0) ; "RTN","ISIIMPU1",240,0) ; -- ETHNICITY -- "RTN","ISIIMPU1",241,0) I $G(ISIMISC("ETHNICITY"))'="" D "RTN","ISIIMPU1",242,0) . S FIELD=$P(MISCDEF("ETHNICITY"),"|",2) "RTN","ISIIMPU1",243,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) ;ethnicity information is multiple "RTN","ISIIMPU1",244,0) . S VALUE=ISIMISC("ETHNICITY") "RTN","ISIIMPU1",245,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",246,0) . S FILE=2 ;set back to default "RTN","ISIIMPU1",247,0) . I RESULT S ISIMISC("ETHNICITY")=RESULT "RTN","ISIIMPU1",248,0) . Q "RTN","ISIIMPU1",249,0) Q:EXIT "-1^Invalid ETHNICITY INFORMATION (#2.06,.01)" "RTN","ISIIMPU1",250,0) ; "RTN","ISIIMPU1",251,0) I $G(ISIMISC("SSN"))'="" D "RTN","ISIIMPU1",252,0) . I ISIMISC("IMP_TYPE")="B" S EXIT=1,MSG="-1^Can't use full SSN with IMP_TYPE='B' (BATCH)" Q "RTN","ISIIMPU1",253,0) . I $D(^DPT("SSN",$G(ISIMISC("SSN")))) S EXIT=1,MSG="-1^Duplicate SSN" Q "RTN","ISIIMPU1",254,0) . I ISIMISC("SSN")'?1N.N S EXIT=1,MSG="-1^SSN must be numeric." Q "RTN","ISIIMPU1",255,0) . I $L(ISIMISC("SSN"))'=9 S EXIT=1,MSG="-1^SSN must have 9 digits." Q "RTN","ISIIMPU1",256,0) Q:EXIT MSG "RTN","ISIIMPU1",257,0) ; "RTN","ISIIMPU1",258,0) ;-- SSN_MASK -- "RTN","ISIIMPU1",259,0) I $G(ISIMISC("SSN_MASK"))'="" D "RTN","ISIIMPU1",260,0) . S FIELD=4,VALUE=ISIMISC("SSN_MASK") "RTN","ISIIMPU1",261,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",262,0) . Q "RTN","ISIIMPU1",263,0) Q:EXIT "-1^Invalid SSN_MASK" "RTN","ISIIMPU1",264,0) ; "RTN","ISIIMPU1",265,0) ;-- STREET_ADD1 -- "RTN","ISIIMPU1",266,0) I $G(ISIMISC("STREET_ADD1"))'="" D "RTN","ISIIMPU1",267,0) . S FIELD=$P(MISCDEF("STREET_ADD1"),"|",2),VALUE=ISIMISC("STREET_ADD1") "RTN","ISIIMPU1",268,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",269,0) . Q "RTN","ISIIMPU1",270,0) Q:EXIT "-1^Invalid STREET_ADDD1 (#2,.111)" "RTN","ISIIMPU1",271,0) ; "RTN","ISIIMPU1",272,0) ;-- STREET_ADD2 -- "RTN","ISIIMPU1",273,0) I $G(ISIMISC("STREET_ADD2"))'="" D "RTN","ISIIMPU1",274,0) . S FIELD=$P(MISCDEF("STREET_ADD2"),"|",2),VALUE=ISIMISC("STREET_ADD2") "RTN","ISIIMPU1",275,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",276,0) . Q "RTN","ISIIMPU1",277,0) Q:EXIT "-1^Invalid STREET_ADDD2 (#2,.112)" "RTN","ISIIMPU1",278,0) ; "RTN","ISIIMPU1",279,0) ;-- CITY -- "RTN","ISIIMPU1",280,0) I $G(ISIMISC("CITY"))'="" D "RTN","ISIIMPU1",281,0) . S FIELD=$P(MISCDEF("CITY"),"|",2),VALUE=ISIMISC("CITY") "RTN","ISIIMPU1",282,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",283,0) . Q "RTN","ISIIMPU1",284,0) Q:EXIT "-1^Invalid CITY (#2,.114)" "RTN","ISIIMPU1",285,0) ; "RTN","ISIIMPU1",286,0) ;-- STATE -- "RTN","ISIIMPU1",287,0) I $G(ISIMISC("STATE"))'="" D "RTN","ISIIMPU1",288,0) . S FIELD=$P(MISCDEF("STATE"),"|",2),VALUE=ISIMISC("STATE") "RTN","ISIIMPU1",289,0) . I $L(VALUE)=2 S VALUE=$O(^DIC(5,"C",VALUE,"")),VALUE=$P($G(^DIC(5,VALUE,0)),U),ISIMISC("STATE")=VALUE ;convert from abrev. "RTN","ISIIMPU1",290,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",291,0) . I RESULT S ISIMISC("STATE")=RESULT "RTN","ISIIMPU1",292,0) . Q "RTN","ISIIMPU1",293,0) Q:EXIT "-1^Invalid STATE (#2,.115)" "RTN","ISIIMPU1",294,0) ; "RTN","ISIIMPU1",295,0) ;-- ZIP_4 -- "RTN","ISIIMPU1",296,0) I $G(ISIMISC("ZIP_4"))'="" D "RTN","ISIIMPU1",297,0) . S FIELD=$P(MISCDEF("ZIP_4"),"|",2),VALUE=ISIMISC("ZIP_4") "RTN","ISIIMPU1",298,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",299,0) . Q "RTN","ISIIMPU1",300,0) Q:EXIT "-1^Invalid ZIP_4 (#2,.1112)" "RTN","ISIIMPU1",301,0) ; "RTN","ISIIMPU1",302,0) ;ZIP_4_MASK "RTN","ISIIMPU1",303,0) I $G(ISIMISC("ZIP_4_MASK"))'="" D "RTN","ISIIMPU1",304,0) . S FIELD=9,VALUE=ISIMISC("ZIP_4_MASK") "RTN","ISIIMPU1",305,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",306,0) . Q "RTN","ISIIMPU1",307,0) Q:EXIT "-1^Invalid ZIP_4_MASK. 5 digits max. Only numbers" "RTN","ISIIMPU1",308,0) ; "RTN","ISIIMPU1",309,0) ;PH_NUM "RTN","ISIIMPU1",310,0) I $G(ISIMISC("PH_NUM"))'="" D "RTN","ISIIMPU1",311,0) . S FIELD=$P(MISCDEF("PH_NUM"),"|",2),VALUE=ISIMISC("PH_NUM") "RTN","ISIIMPU1",312,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",313,0) . Q "RTN","ISIIMPU1",314,0) Q:EXIT "-1^Invalid PH_NUM (#2,.131)" "RTN","ISIIMPU1",315,0) ; "RTN","ISIIMPU1",316,0) ;PH_NUM_MASK "RTN","ISIIMPU1",317,0) I $G(ISIMISC("PH_NUM_MASK"))'="" D "RTN","ISIIMPU1",318,0) . S FIELD=10,VALUE=ISIMISC("PH_NUM_MASK") "RTN","ISIIMPU1",319,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU1",320,0) . Q "RTN","ISIIMPU1",321,0) Q:EXIT "-1^Invalid PH_NUM_MASK. Numeric between 0 and 999999" "RTN","ISIIMPU1",322,0) ; "RTN","ISIIMPU1",323,0) ;VETERAN "RTN","ISIIMPU1",324,0) I $G(ISIMISC("VETERAN"))'="" D "RTN","ISIIMPU1",325,0) . S VALUE=$$UP^XLFSTR(ISIMISC("VETERAN")) "RTN","ISIIMPU1",326,0) . S VALUE=$E(VALUE) "RTN","ISIIMPU1",327,0) . S EXIT=$S(VALUE="Y":0,VALUE="N":0,1:"N") "RTN","ISIIMPU1",328,0) . Q "RTN","ISIIMPU1",329,0) Q:EXIT "-1^Invalid VETERAN (#2,1901)" "RTN","ISIIMPU1",330,0) ; "RTN","ISIIMPU1",331,0) ;EMPLOY_STAT "RTN","ISIIMPU1",332,0) I $G(ISIMISC("EMPLOY_STAT"))'="" D "RTN","ISIIMPU1",333,0) . S FIELD=$P(MISCDEF("EMPLOY_STAT"),"|",2),VALUE=ISIMISC("EMPLOY_STAT") "RTN","ISIIMPU1",334,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",335,0) . I RESULT S ISIMISC("EMPLOY_STAT")=RESULT "RTN","ISIIMPU1",336,0) . Q "RTN","ISIIMPU1",337,0) Q:EXIT "-1^Invalid EMPLOY_STAT (#2,.31115)" "RTN","ISIIMPU1",338,0) ; "RTN","ISIIMPU1",339,0) ;INSUR_TYPE "RTN","ISIIMPU1",340,0) I $G(ISIMISC("INSUR_TYPE"))'="" D "RTN","ISIIMPU1",341,0) . S FIELD=$P(MISCDEF("INSUR_TYPE"),"|",2),FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) "RTN","ISIIMPU1",342,0) . S VALUE=ISIMISC("INSUR_TYPE") "RTN","ISIIMPU1",343,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU1",344,0) . I RESULT S ISIMISC("INSUR_TYPE")=RESULT "RTN","ISIIMPU1",345,0) . S FILE=2 "RTN","ISIIMPU1",346,0) . Q "RTN","ISIIMPU1",347,0) Q:EXIT "-1^Invalid INSUR_TYPE (#2,.3121)" "RTN","ISIIMPU1",348,0) ; "RTN","ISIIMPU1",349,0) ;MRG_SOURCE "RTN","ISIIMPU1",350,0) I $G(ISIMISC("MRG_SOURCE"))'="" D "RTN","ISIIMPU1",351,0) . S VALUE=ISIMISC("MRG_SOURCE") "RTN","ISIIMPU1",352,0) . N Z S Z=+VALUE I $D(^DPT(Z,0)) Q "RTN","ISIIMPU1",353,0) . I $O(^DPT("B",VALUE,"")) S ISIMISC("MRG_SOURCE")=$O(^DPT("B",VALUE,"")) Q "RTN","ISIIMPU1",354,0) . S EXIT=1 "RTN","ISIIMPU1",355,0) . Q "RTN","ISIIMPU1",356,0) Q:EXIT "-1^Invalid MRG_SOURCE (#2,.01)" "RTN","ISIIMPU1",357,0) ; "RTN","ISIIMPU1",358,0) Q ISIRC "RTN","ISIIMPU2") 0^9^B22535078 "RTN","ISIIMPU2",1,0) ISIIMPU2 ;ISI GROUP/MLS -- IMPORT Utility "RTN","ISIIMPU2",2,0) ;;1.0;;;Jun 26,2012;Build 58 "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) ;;CDATE |FIELD |44.003,303 |Appointment DATE/TIME CHECKED OUT value "RTN","ISIIMPU2",23,0) ;;CLIN |FIELD |44,.01 |HOSPITAL LOCATION "RTN","ISIIMPU2",24,0) ;;PATIENT |FIELD |2,.09 |PATIENT (SSN or DFN) "RTN","ISIIMPU2",25,0) ;;PAT_SSN |FIELD |2,.09 |PATIENT (SSN or DFN) "RTN","ISIIMPU2",26,0) ;;PROVIDER |FIELD |9000010.06,.01 |PROVIDER "RTN","ISIIMPU2",27,0) Q "RTN","ISIIMPU2",28,0) ; "RTN","ISIIMPU2",29,0) APPTMISC(MISC,ISIMISC) "RTN","ISIIMPU2",30,0) ; "RTN","ISIIMPU2",31,0) ;INPUT: "RTN","ISIIMPU2",32,0) ; MISC - raw list values from RPC client "RTN","ISIIMPU2",33,0) ; "RTN","ISIIMPU2",34,0) ;OUTPUT: "RTN","ISIIMPU2",35,0) ; ADATE - Appointment Date/Time "RTN","ISIIMPU2",36,0) ; CLIN - Clinic "RTN","ISIIMPU2",37,0) ; DFN - Patient "RTN","ISIIMPU2",38,0) ; "RTN","ISIIMPU2",39,0) N MISCDEF "RTN","ISIIMPU2",40,0) K ISIMISC "RTN","ISIIMPU2",41,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPU2",42,0) S ISIRC=$$APPTMISC1("ISIMISC") "RTN","ISIIMPU2",43,0) Q ISIRC ;return code "RTN","ISIIMPU2",44,0) ; "RTN","ISIIMPU2",45,0) APPTMISC1(DSTNODE) "RTN","ISIIMPU2",46,0) N PARAM,VALUE,DATE,RESULT,MSG,EXIT "RTN","ISIIMPU2",47,0) S (EXIT,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPU2",48,0) F S I=$O(MISC(I)) Q:I="" D Q:EXIT "RTN","ISIIMPU2",49,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPU2",50,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPU2",51,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed: "_PARAM,EXIT=1 Q "RTN","ISIIMPU2",52,0) . I VALUE="" S ISIRC="-1^No data provided for parameter: "_PARAM,EXIT=1 Q "RTN","ISIIMPU2",53,0) . I PARAM["DATE" D "RTN","ISIIMPU2",54,0) . . S DATE=VALUE D DT^DILF("T",DATE,.RESULT,"",.MSG) "RTN","ISIIMPU2",55,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid appointment date:"_$G(PARAM)_"="_$G(VALUE) Q "RTN","ISIIMPU2",56,0) . . I $P(RESULT,".",2)="" S $P(RESULT,".",2)="12" "RTN","ISIIMPU2",57,0) . . S VALUE=RESULT "RTN","ISIIMPU2",58,0) . . D NOW^%DTC I RESULT>% S EXIT=1,ISIRC="-1^Future appointment date not allowed." "RTN","ISIIMPU2",59,0) . . Q "RTN","ISIIMPU2",60,0) . I EXIT Q "RTN","ISIIMPU2",61,0) . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPU2",62,0) . Q "RTN","ISIIMPU2",63,0) Q ISIRC ;return code "RTN","ISIIMPU2",64,0) ; "RTN","ISIIMPU2",65,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPU2",66,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPU2",67,0) K MISCDEF "RTN","ISIIMPU2",68,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPU2",69,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPU2",70,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPU2",71,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPU2",72,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPU2",73,0) Q "RTN","ISIIMPU2",74,0) ; "RTN","ISIIMPU2",75,0) VALAPPT() "RTN","ISIIMPU2",76,0) ; Input - ADATE (Appointment date) "RTN","ISIIMPU2",77,0) ; - SC (HOSPITAL LOCATION #44) "RTN","ISIIMPU2",78,0) ; - DFN (SSN or DFN #2) "RTN","ISIIMPU2",79,0) ; Output - ISIRC [return code] "RTN","ISIIMPU2",80,0) ; "RTN","ISIIMPU2",81,0) N EXIT,IDT,RDT,PROV "RTN","ISIIMPU2",82,0) S EXIT="" "RTN","ISIIMPU2",83,0) I $G(ADATE)="" Q "-1^Missing date/time for appt (ADATE)." "RTN","ISIIMPU2",84,0) I $G(SC)="" Q "-1^Missing appt. location (#44)." "RTN","ISIIMPU2",85,0) I $G(DFN)="" Q "-1^Missing patient identifier (#2)." "RTN","ISIIMPU2",86,0) ; "RTN","ISIIMPU2",87,0) I $P(ADATE,".",2)="" Q "-1^Missing time for appt. (ADATE)." "RTN","ISIIMPU2",88,0) ; check Date/time against fileman date/time field "RTN","ISIIMPU2",89,0) S FILE=2.98,FIELD=.001,VALUE=ADATE "RTN","ISIIMPU2",90,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPU2",91,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU2",92,0) . Q "RTN","ISIIMPU2",93,0) Q:EXIT "-1^Invalid appt date/time (ADATE)." "RTN","ISIIMPU2",94,0) ; "RTN","ISIIMPU2",95,0) S CDATE=$G(CDATE) ; pulled from ISIMISC("CDATE") "RTN","ISIIMPU2",96,0) I CDATE D "RTN","ISIIMPU2",97,0) . I $P(CDATE,".",2)="" S EXIT="-1^CDATE must be in datetime format" Q "RTN","ISIIMPU2",98,0) . I CDATEIDT I RDT>ADATE Q "-1^Appt. location inactive on appt. date (#44)." "RTN","ISIIMPU2",108,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 58 "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^B2512718 "RTN","ISIIMPU9",1,0) ISIIMPU9 ;;ISI GROUP/MLS -- MED IMPORT Utility "RTN","ISIIMPU9",2,0) ;;1.0;;;Jun 26,2012;Build 58 "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 |52,8 |# 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) ; Check VA PRODUCT file for RX NORM value (OROVILLE specific) "RTN","ISIIMPU9",89,0) I $D(^PSNDF(50.68,"VARXCUI",$G(ISIMISC("DRUG")))) D "RTN","ISIIMPU9",90,0) . N VAPROD,DRUG S (VAPROD,DRUG)=0 "RTN","ISIIMPU9",91,0) . F S VAPROD=$O(^PSNDF(50.68,"VARXCUI",ISIMISC("DRUG"),VAPROD)) Q:'VAPROD!DRUG D "RTN","ISIIMPU9",92,0) . . S DRUG=$O(^PSDRUG("AC0P",VAPROD,"")) I DRUG S ISIMISC("DRUG")=$P($G(^PSDRUG(DRUG,0)),U) "RTN","ISIIMPU9",93,0) . . Q "RTN","ISIIMPU9",94,0) . Q "RTN","ISIIMPU9",95,0) ; "RTN","ISIIMPU9",96,0) I $G(ISIMISC("DRUG"))="" Q "-1^Missing DRUG (#50,.01) value." "RTN","ISIIMPU9",97,0) ; "RTN","ISIIMPU9",98,0) I $D(ISIMISC("DRUG")) D "RTN","ISIIMPU9",99,0) . S VALUE=ISIMISC("DRUG") "RTN","ISIIMPU9",100,0) . I '$D(^PSDRUG(VALUE,0)) S VALUE=$O(^PSDRUG("B",VALUE,"")) "RTN","ISIIMPU9",101,0) . I 'VALUE S EXIT=1 Q "RTN","ISIIMPU9",102,0) . I $P($G(^PSDRUG(VALUE,2)),U,1)="" S EXIT=1 Q ;Missing pointer to Orderable item #50.7 "RTN","ISIIMPU9",103,0) . ;I $P($G(^PSDRUG(VALUE,0)),U,3)="" S EXIT=1 Q ;Missing DEA value "RTN","ISIIMPU9",104,0) . ;I $P($G(^PSDRUG(VALUE,660)),U,6)="" S EXIT=1 Q ;Missing unit price "RTN","ISIIMPU9",105,0) . S ISIMISC("DRUG")=VALUE "RTN","ISIIMPU9",106,0) . Q "RTN","ISIIMPU9",107,0) Q:EXIT "-1^Invalid DRUG (#50,.01) value." "RTN","ISIIMPU9",108,0) ; "RTN","ISIIMPU9",109,0) ; -- DATE -- "RTN","ISIIMPU9",110,0) I $G(ISIMISC("DATE"))="" Q "-1^Missing Fill Date" "RTN","ISIIMPU9",111,0) I $G(ISIMISC("EXPIRDT"))="" Q "-1^Missing Expire Date" "RTN","ISIIMPU9",112,0) ; "RTN","ISIIMPU9",113,0) ; -- SIG -- "RTN","ISIIMPU9",114,0) I $G(ISIMISC("SIG"))="" Q "-1^Missing SIG (#51,.01) value." "RTN","ISIIMPU9",115,0) I $D(ISIMISC("SIG")) D "RTN","ISIIMPU9",116,0) . S FIELD=$P(MISCDEF("SIG"),"|",2) "RTN","ISIIMPU9",117,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) "RTN","ISIIMPU9",118,0) . S VALUE=ISIMISC("SIG") "RTN","ISIIMPU9",119,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPU9",120,0) . S VALUE=$O(^PS(51,"B",VALUE,"")) "RTN","ISIIMPU9",121,0) . I $P(^PS(51,VALUE,0),U,4)>1 S EXIT=1 Q ;#51,30 Intended use is Inpatient only "RTN","ISIIMPU9",122,0) . Q "RTN","ISIIMPU9",123,0) Q:EXIT "-1^Invalid Medication Instruction/SIG (#51,.01) value." "RTN","ISIIMPU9",124,0) ; "RTN","ISIIMPU9",125,0) ; -- QTY -- "RTN","ISIIMPU9",126,0) I $G(ISIMISC("QTY"))="" Q "-1^Missing QTY (quantity) value." "RTN","ISIIMPU9",127,0) S VALUE=ISIMISC("QTY") I VALUE'?1N.N Q "-1^Invalid QTY (quantity) value. Must be number." "RTN","ISIIMPU9",128,0) ; "RTN","ISIIMPU9",129,0) ; -- SUPPLY -- "RTN","ISIIMPU9",130,0) I $G(ISIMISC("SUPPLY"))="" Q "-1^Missing SUPPLY (DAYS SUPPLY) value." "RTN","ISIIMPU9",131,0) S VALUE=ISIMISC("SUPPLY") I VALUE'?1N.N Q "-1^Invalid SUPPLY (DAYS SUPPLY)value. Must be number." "RTN","ISIIMPU9",132,0) ; "RTN","ISIIMPU9",133,0) ; -- REFILL -- "RTN","ISIIMPU9",134,0) I $G(ISIMISC("REFILL"))="" Q "-1^Missing REFILL (# of refills) value." "RTN","ISIIMPU9",135,0) S VALUE=ISIMISC("QTY") I VALUE'?1N.N Q "-1^Invalid REFILL (# or refills) value. Must be number." "RTN","ISIIMPU9",136,0) ; "RTN","ISIIMPU9",137,0) ; -- PROV -- "RTN","ISIIMPU9",138,0) I $G(ISIMISC("PROV"))'="" D "RTN","ISIIMPU9",139,0) . S FIELD=$P(MISCDEF("PROV"),"|",2) "RTN","ISIIMPU9",140,0) . S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2) "RTN","ISIIMPU9",141,0) . S VALUE=ISIMISC("PROV") "RTN","ISIIMPU9",142,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPU9",143,0) . ;if multiple entries, check for valid entry "RTN","ISIIMPU9",144,0) . S EXIT=1 "RTN","ISIIMPU9",145,0) . S Y=0 F S Y=$O(^VA(200,"B",VALUE,Y)) Q:Y="" D "RTN","ISIIMPU9",146,0) . . I +$G(^VA(200,Y,"PS"))'=1 Q ;Authorized to write medical orders check "RTN","ISIIMPU9",147,0) . . S EXIT=0,ISIMISC("PROV")=Y "RTN","ISIIMPU9",148,0) . . Q "RTN","ISIIMPU9",149,0) I $G(ISIMISC("PROV"))="" D "RTN","ISIIMPU9",150,0) . S EXIT=1 "RTN","ISIIMPU9",151,0) . I +$G(^VA(200,DUZ,"PS"))'=1 Q ; "RTN","ISIIMPU9",152,0) . S ISIMISC("PROV")=DUZ,EXIT=0 "RTN","ISIIMPU9",153,0) . Q "RTN","ISIIMPU9",154,0) Q:EXIT "-1^Invalid PROVIDER (#200,.01)." "RTN","ISIIMPU9",155,0) ; "RTN","ISIIMPU9",156,0) S PSOSITE=0 F S PSOSITE=$O(^PS(59,PSOSITE)) Q:'PSOSITE D I $G(ISIMISC("PSOSITE"))'="" Q "RTN","ISIIMPU9",157,0) . S Y=+$G(^PS(59,PSOSITE,"I")) "RTN","ISIIMPU9",158,0) . I Y="" S ISIMISC("PSOSITE")=PSOSITE Q "RTN","ISIIMPU9",159,0) . I Y>DT Q "RTN","ISIIMPU9",160,0) . S ISIMISC("PSOSITE")=PSOSITE "RTN","ISIIMPU9",161,0) . Q "RTN","ISIIMPU9",162,0) Q:$G(ISIMISC("PSOSITE"))="" "-1^Can't locate valid OUTPATIENT SITE FILE (#59)." "RTN","ISIIMPU9",163,0) ; "RTN","ISIIMPU9",164,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 58 "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-30) "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) I TABLE="PNTTYPE" Q 23 ;PNTTYPE "RTN","ISIIMPUA",39,0) I TABLE="MARSTAT" Q 24 ;MARSTAT "RTN","ISIIMPUA",40,0) I TABLE="STATE" Q 25 ;STATE "RTN","ISIIMPUA",41,0) I TABLE="SERVICE" Q 26 ;SERVICE "RTN","ISIIMPUA",42,0) I TABLE="HFACTOR" Q 27 ;Health Factors "RTN","ISIIMPUA",43,0) I TABLE="CPT" Q 28 ;CPT codes "RTN","ISIIMPUA",44,0) I TABLE="PRVNAR" Q 29 ; Provider Narrative "RTN","ISIIMPUA",45,0) I TABLE="IMZ" Q 30 ;Immunization "RTN","ISIIMPUA",46,0) I TABLE="EXAM" Q 31 "RTN","ISIIMPUA",47,0) I TABLE="EDTOPIC" Q 32 "RTN","ISIIMPUA",48,0) ;I TABLE="RB" Q 33 ;Room-Bed "RTN","ISIIMPUA",49,0) ;I TABLE="WARD" Q 34 ;WARD "RTN","ISIIMPUA",50,0) Q -1 "RTN","ISIIMPUA",51,0) ; "RTN","ISIIMPUA",52,0) ENTRY(ARRAY,LIST) "RTN","ISIIMPUA",53,0) ;INPUT: "RTN","ISIIMPUA",54,0) ; ARRAY = output Array "RTN","ISIIMPUA",55,0) ; LIST = numeric to choose FILE "RTN","ISIIMPUA",56,0) ; "RTN","ISIIMPUA",57,0) ;OUTPUT: "RTN","ISIIMPUA",58,0) ; ARRAY(0)=CNT ;numeric "RTN","ISIIMPUA",59,0) ; ARRAY(1)=VALUE ;text "RTN","ISIIMPUA",60,0) ; "RTN","ISIIMPUA",61,0) K ARRAY "RTN","ISIIMPUA",62,0) I LIST'?1N.N S ARRAY(0)="-1^Incorrect parameter passed" Q "RTN","ISIIMPUA",63,0) I LIST=1 D TIULIST Q "RTN","ISIIMPUA",64,0) I LIST=2 D DRUGLIST Q "RTN","ISIIMPUA",65,0) I LIST=3 D SIGLIST Q "RTN","ISIIMPUA",66,0) I LIST=4 D PROVLIST Q "RTN","ISIIMPUA",67,0) I LIST=5 D USERLIST Q "RTN","ISIIMPUA",68,0) I LIST=6 D RACE Q "RTN","ISIIMPUA",69,0) I LIST=7 D ETHNICITY Q "RTN","ISIIMPUA",70,0) I LIST=8 D EMPLOYSTAT Q "RTN","ISIIMPUA",71,0) I LIST=9 D INSURANCE Q "RTN","ISIIMPUA",72,0) I LIST=10 D LOCATION Q "RTN","ISIIMPUA",73,0) I LIST=11 D ICD9 Q "RTN","ISIIMPUA",74,0) I LIST=12 D VITALTYPE Q "RTN","ISIIMPUA",75,0) I LIST=13 D ALLERGEN Q "RTN","ISIIMPUA",76,0) I LIST=14 D SYMPTOM Q "RTN","ISIIMPUA",77,0) I LIST=15 D LABTESTS Q "RTN","ISIIMPUA",78,0) I LIST=16 D GENDER Q "RTN","ISIIMPUA",79,0) I LIST=17 D BOOLEEN Q "RTN","ISIIMPUA",80,0) I LIST=18 D PROBSTAT Q "RTN","ISIIMPUA",81,0) I LIST=19 D PROBTYPE Q "RTN","ISIIMPUA",82,0) I LIST=20 D CONSULT Q "RTN","ISIIMPUA",83,0) I LIST=21 D IMAGLOC Q ; "RTN","ISIIMPUA",84,0) I LIST=22 D RAPROC Q ; "RTN","ISIIMPUA",85,0) I LIST=23 D PNTTYPE Q "RTN","ISIIMPUA",86,0) I LIST=24 D MARSTAT Q "RTN","ISIIMPUA",87,0) I LIST=25 D STATE Q "RTN","ISIIMPUA",88,0) I LIST=26 D SERVICE Q "RTN","ISIIMPUA",89,0) I LIST=27 D HFACTOR Q ;Health Factors "RTN","ISIIMPUA",90,0) I LIST=28 D ICPT Q ;CPT codes "RTN","ISIIMPUA",91,0) I LIST=29 D PRVNAR Q ; Provider Narrative "RTN","ISIIMPUA",92,0) I LIST=30 D IMZ Q ;Immunization "RTN","ISIIMPUA",93,0) I LIST=31 D EXAM Q ;EXAM "RTN","ISIIMPUA",94,0) I LIST=32 D EDTOPIC Q ;EDUCATION TOPICS "RTN","ISIIMPUA",95,0) ;I LIST=32 Q ;Room-Bed "RTN","ISIIMPUA",96,0) ;I LIST=33 Q ;WARD "RTN","ISIIMPUA",97,0) S ARRAY(0)="-1^Incorrect parameter passed" Q "RTN","ISIIMPUA",98,0) Q "RTN","ISIIMPUA",99,0) ; "RTN","ISIIMPUA",100,0) HDR ;not used -- was thinking about producing entire "TABLES" worksheet as output "RTN","ISIIMPUA",101,0) S HDR="Gender,Booleen,Race,Ethnicity,Employ_Status,Insurance,Location,Person,ICD9_Desc,Problem_status,Problem_Type,Vital_type" "RTN","ISIIMPUA",102,0) S HDR=HDR_",Allergen,Symptom,Lab_test,Case,Note_title,drug_list,siglist" "RTN","ISIIMPUA",103,0) Q "RTN","ISIIMPUA",104,0) ; "RTN","ISIIMPUA",105,0) TIULIST ;#8925.1 "RTN","ISIIMPUA",106,0) N VALUE,IEN,RESULT,CNT "RTN","ISIIMPUA",107,0) S VALUE="",CNT=0 "RTN","ISIIMPUA",108,0) F S VALUE=$O(^TIU(8925.1,"B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",109,0) . S IEN=$O(^TIU(8925.1,"B",VALUE,"")) I IEN="" Q "RTN","ISIIMPUA",110,0) . N ZREC S ZREC=$G(^TIU(8925.1,IEN,0)) I ZREC="" Q "RTN","ISIIMPUA",111,0) . I $P(ZREC,U,4)'="DOC" Q ; TIU Type of DOC "RTN","ISIIMPUA",112,0) . I $P(ZREC,U,7)'=11 Q ;TIU status of Active "RTN","ISIIMPUA",113,0) . N RESULT D ISCNSLT^TIUCNSLT(.RESULT,IEN) I RESULT'=0 Q ;No CONSULT types "RTN","ISIIMPUA",114,0) . S CNT=CNT+1 S ARRAY(CNT)=VALUE "RTN","ISIIMPUA",115,0) S ARRAY(0)=CNT I CNT=0 S ARRAY(0)="-1^No results found." "RTN","ISIIMPUA",116,0) Q "RTN","ISIIMPUA",117,0) ; "RTN","ISIIMPUA",118,0) DRUGLIST ;#50 "RTN","ISIIMPUA",119,0) N VALUE,IEN,CNT "RTN","ISIIMPUA",120,0) S VALUE="",CNT=0 "RTN","ISIIMPUA",121,0) F S VALUE=$O(^PSDRUG("B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",122,0) . S IEN=$O(^PSDRUG("B",VALUE,"")) "RTN","ISIIMPUA",123,0) . I $P($G(^PSDRUG(IEN,2)),"^",1)="" Q ;Missing pointer to Orderable item #50.7 "RTN","ISIIMPUA",124,0) . I $P($G(^PSDRUG(IEN,0)),"^",3)="" Q ;Missing DEA value "RTN","ISIIMPUA",125,0) . I $P($G(^PSDRUG(IEN,660)),"^",6)="" Q ;Missing unit price "RTN","ISIIMPUA",126,0) . S CNT=CNT+1 S ARRAY(CNT)=VALUE "RTN","ISIIMPUA",127,0) . Q "RTN","ISIIMPUA",128,0) S ARRAY(0)=CNT I CNT=0 S ARRAY(0)="-1^No results found." "RTN","ISIIMPUA",129,0) Q "RTN","ISIIMPUA",130,0) ; "RTN","ISIIMPUA",131,0) SIGLIST ;#51 "RTN","ISIIMPUA",132,0) N VALUE,IEN,CNT "RTN","ISIIMPUA",133,0) S VALUE="",CNT=0 "RTN","ISIIMPUA",134,0) F S VALUE=$O(^PS(51,"B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",135,0) . S IEN=$O(^PS(51,"B",VALUE,"")) "RTN","ISIIMPUA",136,0) . I $P(^PS(51,IEN,0),U,4)>1 Q ;#51,30 Intended use is Inpatient only "RTN","ISIIMPUA",137,0) . S CNT=CNT+1 S ARRAY(CNT)=VALUE "RTN","ISIIMPUA",138,0) . Q "RTN","ISIIMPUA",139,0) S ARRAY(0)=CNT I CNT=0 S ARRAY(0)="-1^No results found." "RTN","ISIIMPUA",140,0) Q "RTN","ISIIMPUA",141,0) ; "RTN","ISIIMPUA",142,0) PROVLIST ;#200 "RTN","ISIIMPUA",143,0) N VALUE,IEN,DTC,IDT,CNT,NAME "RTN","ISIIMPUA",144,0) D NOW^%DTC S DTC=X,VALUE="",CNT=0 "RTN","ISIIMPUA",145,0) F S VALUE=$O(^VA(200,"B",VALUE)) Q:VALUE="" D "RTN","ISIIMPUA",146,0) . S IEN=$O(^VA(200,"B",VALUE,"")) "RTN","ISIIMPUA",147,0) . I +$G(^VA(200,IEN,"PS"))'=1 Q ;Authorized to write medical orders check "RTN","ISIIMPUA",148,0) . S IDT=$P($G(^VA(200,IEN,"PS")),U,4) I IDT'="" I IDTIDT I RDT>DTC Q "RTN","ISIIMPUA",221,0) . I RDT'="" I RDTDTC Q "RTN","ISIIMPUA",450,0) . . N Z S Z=$P($G(^DIC(49,IEN,3,X,0)),U,2) I Z,ZIDT I RDT>DT S EXIT=1 Q "RTN","ISIIMPUB",97,0) . I RDT'="" I RDTIDT I RDT>TDY S EXIT=1 Q "RTN","ISIIMPUC",165,0) . I RDT'="" I RDTISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPUD",176,0) . Q "RTN","ISIIMPUD",177,0) Q:EXIT "-1^Invalid LOW_DOB (#200,5)" "RTN","ISIIMPUD",178,0) ; "RTN","ISIIMPUD",179,0) ;-- UP_DOB -- "RTN","ISIIMPUD",180,0) I $G(ISIMISC("UP_DOB"))'="" D "RTN","ISIIMPUD",181,0) . S FIELD=$P(MISCDEF("UP_DOB"),"|",2),VALUE=ISIMISC("UP_DOB") "RTN","ISIIMPUD",182,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPUD",183,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPUD",184,0) . I $G(ISIMISC("LOW_DOB"))'="" D "RTN","ISIIMPUD",185,0) . . I ISIMISC("LOW_DOB")>ISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPUD",186,0) . . Q "RTN","ISIIMPUD",187,0) . Q "RTN","ISIIMPUD",188,0) Q:EXIT "-1^Invalid UP_DOB (#200,5)" "RTN","ISIIMPUD",189,0) ; "RTN","ISIIMPUD",190,0) I $G(ISIMISC("SSN"))'="" D "RTN","ISIIMPUD",191,0) . I ISIMISC("IMP_TYPE")="B" S EXIT=1,MSG="-1^Can't use full SSN with IMP_TYPE='B' (BATCH)" Q "RTN","ISIIMPUD",192,0) . I $D(^VA(200,"SSN",$G(ISIMISC("SSN")))) S EXIT=1,MSG="-1^Duplicate SSN" Q "RTN","ISIIMPUD",193,0) . I ISIMISC("SSN")'?1N.N S EXIT=1,MSG="-1^SSN must be numeric." Q "RTN","ISIIMPUD",194,0) . I $L(ISIMISC("SSN"))'=9 S EXIT=1,MSG="-1^SSN must have 9 digits." Q "RTN","ISIIMPUD",195,0) Q:EXIT MSG "RTN","ISIIMPUD",196,0) ; "RTN","ISIIMPUD",197,0) ;-- SSN_MASK -- "RTN","ISIIMPUD",198,0) I $G(ISIMISC("SSN_MASK"))'="" D "RTN","ISIIMPUD",199,0) . S FIELD=4,VALUE=ISIMISC("SSN_MASK") "RTN","ISIIMPUD",200,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",201,0) . Q "RTN","ISIIMPUD",202,0) Q:EXIT "-1^Invalid SSN_MASK" "RTN","ISIIMPUD",203,0) ; "RTN","ISIIMPUD",204,0) ;-- STREET_ADD1 -- "RTN","ISIIMPUD",205,0) I $G(ISIMISC("STREET_ADD1"))'="" D "RTN","ISIIMPUD",206,0) . S FIELD=$P(MISCDEF("STREET_ADD1"),"|",2),VALUE=ISIMISC("STREET_ADD1") "RTN","ISIIMPUD",207,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",208,0) . Q "RTN","ISIIMPUD",209,0) Q:EXIT "-1^Invalid STREET_ADDD1 (#200,.111)" "RTN","ISIIMPUD",210,0) ; "RTN","ISIIMPUD",211,0) ;-- STREET_ADD2 -- "RTN","ISIIMPUD",212,0) I $G(ISIMISC("STREET_ADD2"))'="" D "RTN","ISIIMPUD",213,0) . S FIELD=$P(MISCDEF("STREET_ADD2"),"|",2),VALUE=ISIMISC("STREET_ADD2") "RTN","ISIIMPUD",214,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",215,0) . Q "RTN","ISIIMPUD",216,0) Q:EXIT "-1^Invalid STREET_ADDD2 (#200,.112)" "RTN","ISIIMPUD",217,0) ; "RTN","ISIIMPUD",218,0) ;-- CITY -- "RTN","ISIIMPUD",219,0) I $G(ISIMISC("CITY"))'="" D "RTN","ISIIMPUD",220,0) . S FIELD=$P(MISCDEF("CITY"),"|",2),VALUE=ISIMISC("CITY") "RTN","ISIIMPUD",221,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",222,0) . Q "RTN","ISIIMPUD",223,0) Q:EXIT "-1^Invalid CITY (#200,.114)" "RTN","ISIIMPUD",224,0) ; "RTN","ISIIMPUD",225,0) ;-- STATE -- "RTN","ISIIMPUD",226,0) I $G(ISIMISC("STATE"))'="" D "RTN","ISIIMPUD",227,0) . S FIELD=$P(MISCDEF("STATE"),"|",2),VALUE=ISIMISC("STATE") "RTN","ISIIMPUD",228,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",229,0) . Q "RTN","ISIIMPUD",230,0) Q:EXIT "-1^Invalid STATE (#200,.115)" "RTN","ISIIMPUD",231,0) ; "RTN","ISIIMPUD",232,0) ;-- ZIP_4 -- "RTN","ISIIMPUD",233,0) I $G(ISIMISC("ZIP_4"))'="" D "RTN","ISIIMPUD",234,0) . S FIELD=$P(MISCDEF("ZIP_4"),"|",2),VALUE=ISIMISC("ZIP_4") "RTN","ISIIMPUD",235,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",236,0) . Q "RTN","ISIIMPUD",237,0) Q:EXIT "-1^Invalid ZIP_4 (#200,.116)" "RTN","ISIIMPUD",238,0) ; "RTN","ISIIMPUD",239,0) ;ZIP_4_MASK "RTN","ISIIMPUD",240,0) I $G(ISIMISC("ZIP_4_MASK"))'="" D "RTN","ISIIMPUD",241,0) . S FIELD=9,VALUE=ISIMISC("ZIP_4_MASK") "RTN","ISIIMPUD",242,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",243,0) . Q "RTN","ISIIMPUD",244,0) Q:EXIT "-1^Invalid ZIP_4_MASK. 5 digits max. Only numbers" "RTN","ISIIMPUD",245,0) ; "RTN","ISIIMPUD",246,0) ;PH_NUM "RTN","ISIIMPUD",247,0) I $G(ISIMISC("PH_NUM"))'="" D "RTN","ISIIMPUD",248,0) . S FIELD=$P(MISCDEF("PH_NUM"),"|",2),VALUE=ISIMISC("PH_NUM") "RTN","ISIIMPUD",249,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",250,0) . Q "RTN","ISIIMPUD",251,0) Q:EXIT "-1^Invalid PH_NUM (#200,.131)" "RTN","ISIIMPUD",252,0) ; "RTN","ISIIMPUD",253,0) ;PH_NUM_MASK "RTN","ISIIMPUD",254,0) I $G(ISIMISC("PH_NUM_MASK"))'="" D "RTN","ISIIMPUD",255,0) . S FIELD=10,VALUE=ISIMISC("PH_NUM_MASK") "RTN","ISIIMPUD",256,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",257,0) . Q "RTN","ISIIMPUD",258,0) Q:EXIT "-1^Invalid PH_NUM_MASK. Numeric between 0 and 999999" "RTN","ISIIMPUD",259,0) ; "RTN","ISIIMPUD",260,0) ;PH_OFFICE "RTN","ISIIMPUD",261,0) I $G(ISIMISC("PH_OFFICE"))'="" D "RTN","ISIIMPUD",262,0) . S FIELD=$P(MISCDEF("PH_OFFICE"),"|",2),VALUE=ISIMISC("PH_OFFICE") "RTN","ISIIMPUD",263,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",264,0) . Q "RTN","ISIIMPUD",265,0) Q:EXIT "-1^Invalid PH_OFFICE (#200,.132)" "RTN","ISIIMPUD",266,0) ; "RTN","ISIIMPUD",267,0) ;SERVICE "RTN","ISIIMPUD",268,0) I $G(ISIMISC("SERVICE"))'="" D "RTN","ISIIMPUD",269,0) . S FIELD=$P(MISCDEF("SERVICE"),"|",2),VALUE=ISIMISC("SERVICE") "RTN","ISIIMPUD",270,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",271,0) . Q "RTN","ISIIMPUD",272,0) Q:EXIT "-1^Invalid SERVICE (#200,29)" "RTN","ISIIMPUD",273,0) ; "RTN","ISIIMPUD",274,0) ;USER_CLASS "RTN","ISIIMPUD",275,0) I $G(ISIMISC("USER_CLASS"))'="" D "RTN","ISIIMPUD",276,0) . S FIELD=$P(MISCDEF("USER_CLASS"),"|",2),VALUE=ISIMISC("USER_CLASS") "RTN","ISIIMPUD",277,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",278,0) . Q "RTN","ISIIMPUD",279,0) Q:EXIT "-1^Invalid USER_CLASS (#200,9.5)" "RTN","ISIIMPUD",280,0) ; "RTN","ISIIMPUD",281,0) ;EMAIL "RTN","ISIIMPUD",282,0) I $G(ISIMISC("EMAIL"))'="" D "RTN","ISIIMPUD",283,0) . S FIELD=$P(MISCDEF("EMAIL"),"|",2),VALUE=ISIMISC("EMAIL") "RTN","ISIIMPUD",284,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",285,0) . Q "RTN","ISIIMPUD",286,0) Q:EXIT "-1^Invalid EMAIL (#200,.15)" "RTN","ISIIMPUD",287,0) ; "RTN","ISIIMPUD",288,0) ;TERM_DATE "RTN","ISIIMPUD",289,0) I $G(ISIMISC("TERM_DATE"))'="" D "RTN","ISIIMPUD",290,0) . S FIELD=$P(MISCDEF("TERM_DATE"),"|",2),VALUE=ISIMISC("TERM_DATE") "RTN","ISIIMPUD",291,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUD",292,0) . Q "RTN","ISIIMPUD",293,0) Q:EXIT "-1^Invalid TERM_DATE (#200,9.2)" "RTN","ISIIMPUD",294,0) ; "RTN","ISIIMPUD",295,0) ;MRG_SOURCE "RTN","ISIIMPUD",296,0) I $G(ISIMISC("MRG_SOURCE"))'="" D "RTN","ISIIMPUD",297,0) . S VALUE=ISIMISC("MRG_SOURCE") "RTN","ISIIMPUD",298,0) . N Z S Z=+VALUE I $D(^VA(200,Z,0)) Q "RTN","ISIIMPUD",299,0) . I $O(^VA(200,"B",VALUE,"")) S ISIMISC("MRG_SOURCE")=$O(^VA(200,"B",VALUE,"")) Q "RTN","ISIIMPUD",300,0) . S EXIT=1 "RTN","ISIIMPUD",301,0) . Q "RTN","ISIIMPUD",302,0) Q:EXIT "-1^Invalid MRG_SOURCE (#200,.01)" "RTN","ISIIMPUD",303,0) ; "RTN","ISIIMPUD",304,0) Q ISIRC "RTN","ISIIMPUD",305,0) ; "RTN","ISIIMPUD",306,0) TEMPLATE "RTN","ISIIMPUD",307,0) N ARRAY,MSG "RTN","ISIIMPUD",308,0) S IENS=$O(^ISI(9001,"B",VALUE,""))_"," "RTN","ISIIMPUD",309,0) D GETS^DIQ(9001,IENS,"*","","ARRAY","MSG") "RTN","ISIIMPUD",310,0) I $G(DIERR) S ISIRC=-1,EXIT=1 Q "RTN","ISIIMPUD",311,0) S @DSTNODE@("NAME_MASK")=ARRAY(9001,IENS,18) ;USER MASK (#9001,18) "RTN","ISIIMPUD",312,0) S @DSTNODE@("SSN_MASK")=ARRAY(9001,IENS,4) "RTN","ISIIMPUD",313,0) S @DSTNODE@("SEX")=ARRAY(9001,IENS,5) "RTN","ISIIMPUD",314,0) S @DSTNODE@("LOW_DOB")=ARRAY(9001,IENS,6) "RTN","ISIIMPUD",315,0) S @DSTNODE@("UP_DOB")=ARRAY(9001,IENS,7) "RTN","ISIIMPUD",316,0) S @DSTNODE@("ZIP_4_MASK")=ARRAY(9001,IENS,9) "RTN","ISIIMPUD",317,0) S @DSTNODE@("PH_NUM_MASK")=ARRAY(9001,IENS,10) "RTN","ISIIMPUD",318,0) S @DSTNODE@("CITY")=ARRAY(9001,IENS,11) "RTN","ISIIMPUD",319,0) S @DSTNODE@("STATE")=ARRAY(9001,IENS,12) "RTN","ISIIMPUD",320,0) S @DSTNODE@("DFN_NAME")=ARRAY(9001,IENS,14) "RTN","ISIIMPUD",321,0) S @DSTNODE@("SERVICE")=ARRAY(9001,IENS,16) "RTN","ISIIMPUD",322,0) S @DSTNODE@("EMAIL_MASK")=ARRAY(9001,IENS,17) "RTN","ISIIMPUD",323,0) S @DSTNODE@("ELSIG_APND")=ARRAY(9001,IENS,19) "RTN","ISIIMPUD",324,0) S @DSTNODE@("ACCESS_APND")=ARRAY(9001,IENS,20) "RTN","ISIIMPUD",325,0) S @DSTNODE@("VERIFY_APND")=ARRAY(9001,IENS,21) "RTN","ISIIMPUD",326,0) Q "RTN","ISIIMPUE") 0^59^B5663049 "RTN","ISIIMPUE",1,0) ISIIMPUE ;ISI GROUP/MLS -- TEMPLATE SAVE Utility "RTN","ISIIMPUE",2,0) ;;1.0;;;May 15,2014;Build 58 "RTN","ISIIMPUE",3,0) Q "RTN","ISIIMPUE",4,0) ; "RTN","ISIIMPUE",5,0) ; Column definitions for MISCDEF table (below): "RTN","ISIIMPUE",6,0) ; NAME= name of parameter "RTN","ISIIMPUE",7,0) ; TYPE = categories of values provided "RTN","ISIIMPUE",8,0) ; 'PARAM' is internal used value "RTN","ISIIMPUE",9,0) ; 'FIELD' is a literal import value "RTN","ISIIMPUE",10,0) ; 'MASK' is dynamic value w/ * wildcard "RTN","ISIIMPUE",11,0) ; FIELD(#2)=the corresponding field in USER(#200) file "RTN","ISIIMPUE",12,0) ; DESC = description of value "RTN","ISIIMPUE",13,0) ; "RTN","ISIIMPUE",14,0) ; Array example: "RTN","ISIIMPUE",15,0) ; MISC(1)="TEMPLATE|DEFAULT" "RTN","ISIIMPUE",16,0) ; MISC(2)="NAME_MASK|*,USER" "RTN","ISIIMPUE",17,0) ; MISC(4)="SEX|F" "RTN","ISIIMPUE",18,0) ; MISC(5)="SSN_MASK|000*" "RTN","ISIIMPUE",19,0) ; "RTN","ISIIMPUE",20,0) MISCDEF ;;+++++ DEFINITIONS OF USER MISC PARAMETERS +++++ "RTN","ISIIMPUE",21,0) ;;NAME |TYPE |FIELD(#200) |DESC "RTN","ISIIMPUE",22,0) ;;--------------------------------------------------------------- "RTN","ISIIMPUE",23,0) ;;NAME |FIELD |.01 |NAME value "RTN","ISIIMPUE",24,0) ;;TYPE |FIELD |1 |TYPE OF PNT (#391) "RTN","ISIIMPUE",25,0) ;;NAME_MASK |FIELD |2 |FREE TEXT "RTN","ISIIMPUE",26,0) ;;SSN_MASK |FIELD |4 |NUMBER "RTN","ISIIMPUE",27,0) ;;SEX |FIELD |5 |M or F "RTN","ISIIMPUE",28,0) ;;EDOB |FIELD |6 |DATE "RTN","ISIIMPUE",29,0) ;;LDOB |FIELD |7 |DATE "RTN","ISIIMPUE",30,0) ;;MARITAL_STATUS |FIELD |8 |POINTER TO #11 "RTN","ISIIMPUE",31,0) ;;ZIP_MASK |FIELD |9 |NUMBER "RTN","ISIIMPUE",32,0) ;;PH_NUM |FIELD |10 |NUMBER "RTN","ISIIMPUE",33,0) ;;CITY |FIELD |11 |FREE TEXT "RTN","ISIIMPUE",34,0) ;;STATE |FIELD |12 |POINTER TO #5 "RTN","ISIIMPUE",35,0) ;;VETERAN |FIELD |13 |'Y' or 'N' "RTN","ISIIMPUE",36,0) ;;DFN_NAME |FIELD |14 |'Y' or 'N' "RTN","ISIIMPUE",37,0) ;;EMPLOY_STAT |FIELD |15 |SET (1-9) (employment Status) "RTN","ISIIMPUE",38,0) ;;SERVICE |FIELD |16 |POINTER TO #49 "RTN","ISIIMPUE",39,0) ;;EMAIL_MASK |FIELD |17 |FREE TEXT (domain format) "RTN","ISIIMPUE",40,0) ;;USER_MASK |FIELD |18 |FREE TEXT (4-30 char) "RTN","ISIIMPUE",41,0) ;;ESIG_APND |FIELD |19 |FREE TEXT (1-5 char) "RTN","ISIIMPUE",42,0) ;;ACCESS_APND |FIELD |20 |FREE TEXT (1-5 char) "RTN","ISIIMPUE",43,0) ;;VERIFY_APND |FIELD |21 |FREE TEXT (2-5 char) "RTN","ISIIMPUE",44,0) Q "RTN","ISIIMPUE",45,0) ; "RTN","ISIIMPUE",46,0) TMPMISC(MISC,ISIMISC) "RTN","ISIIMPUE",47,0) ; "RTN","ISIIMPUE",48,0) ;INPUT: "RTN","ISIIMPUE",49,0) ; MISC - raw list values from RPC client "RTN","ISIIMPUE",50,0) ; "RTN","ISIIMPUE",51,0) ;OUTPUT: "RTN","ISIIMPUE",52,0) ; ISIMISC - indexed values for pnt create/import use "RTN","ISIIMPUE",53,0) ; "RTN","ISIIMPUE",54,0) N MISCDEF "RTN","ISIIMPUE",55,0) K ISIMISC "RTN","ISIIMPUE",56,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPUE",57,0) S ISIRC=$$TMPMISC1("ISIMISC") "RTN","ISIIMPUE",58,0) Q ISIRC "RTN","ISIIMPUE",59,0) ; "RTN","ISIIMPUE",60,0) TMPMISC1(DSTNODE) "RTN","ISIIMPUE",61,0) N RETURN,ERRCNT,I,EXIT,PARAM,VALUE,TMPL,IENS,TYPE,FIELD,DATE,RESULT,MSG "RTN","ISIIMPUE",62,0) S (EXIT,TMPL,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPUE",63,0) F S I=$O(MISC(I)) Q:I=""!EXIT D Q:EXIT "RTN","ISIIMPUE",64,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPUE",65,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPUE",66,0) . I EXIT=1 Q "RTN","ISIIMPUE",67,0) . ; Process TEMPLATE first, then overlay with passed params "RTN","ISIIMPUE",68,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed:"_$G(PARAM),EXIT=1 Q "RTN","ISIIMPUE",69,0) . S TYPE=$P(MISCDEF(PARAM),"|"),FIELD=$P(MISCDEF(PARAM),"|",2) "RTN","ISIIMPUE",70,0) . I PARAM["DOB" D "RTN","ISIIMPUE",71,0) . . S DATE=VALUE D DT^DILF("",DATE,.RESULT,"",.MSG) "RTN","ISIIMPUE",72,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid date value in EDOB or LDOB field." Q "RTN","ISIIMPUE",73,0) . . S VALUE=RESULT "RTN","ISIIMPUE",74,0) . I TYPE="FIELD" D "RTN","ISIIMPUE",75,0) . . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPUE",76,0) . . Q "RTN","ISIIMPUE",77,0) . Q "RTN","ISIIMPUE",78,0) Q ISIRC "RTN","ISIIMPUE",79,0) ; "RTN","ISIIMPUE",80,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPUE",81,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPUE",82,0) K MISCDEF "RTN","ISIIMPUE",83,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPUE",84,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPUE",85,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPUE",86,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPUE",87,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPUE",88,0) Q "RTN","ISIIMPUE",89,0) ; "RTN","ISIIMPUE",90,0) VALIDATE(ISIMISC) "RTN","ISIIMPUE",91,0) ; Entry point to Validate content of template create/array "RTN","ISIIMPUE",92,0) ; Output - ISIRC [return code] "RTN","ISIIMPUE",93,0) N FILE,FIELD,FLAG,VALUE,RESULT,MSG,EXIT,Y,PARAM,MISCDEF "RTN","ISIIMPUE",94,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPUE",95,0) S EXIT=0,FILE=9001,FLAG="" S ISIRC=0 "RTN","ISIIMPUE",96,0) ; "RTN","ISIIMPUE",97,0) ; DFN_NAME "RTN","ISIIMPUE",98,0) ;S X=$E($G(ISIMISC("DFN_NAME"))) S ISIMISC("DFN_NAME")=$S(X="Y":"YES",X="N":"NO",1:"NO") "RTN","ISIIMPUE",99,0) ; "RTN","ISIIMPUE",100,0) S PARAM="" "RTN","ISIIMPUE",101,0) F S PARAM=$O(MISCDEF(PARAM)) Q:(PARAM=""!(EXIT)) D Q:(EXIT) "RTN","ISIIMPUE",102,0) . S FIELD=$P(MISCDEF(PARAM),"|",2),VALUE=$G(ISIMISC(PARAM)) "RTN","ISIIMPUE",103,0) . I PARAM["DOB" S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPUE",104,0) . I $G(VALUE)="" Q "RTN","ISIIMPUE",105,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUE",106,0) Q:EXIT "-1^Invalid "_$G(PARAM)_"(#"_FILE_","_$G(FIELD)_") : "_$G(VALUE) "RTN","ISIIMPUE",107,0) "RTN","ISIIMPUE",108,0) ;-- NAME -- "RTN","ISIIMPUE",109,0) I $G(ISIMISC("NAME"))="" S ISIRC="-1^Missing Template NAME (9001,.01)" Q ISIRC "RTN","ISIIMPUE",110,0) ; "RTN","ISIIMPUE",111,0) ;-- LOW_DOB -- "RTN","ISIIMPUE",112,0) I $G(ISIMISC("LOW_DOB"))'="" D "RTN","ISIIMPUE",113,0) . S FIELD=$P(MISCDEF("LOW_DOB"),"|",2),VALUE=ISIMISC("LOW_DOB") "RTN","ISIIMPUE",114,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPUE",115,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPUE",116,0) . I $G(ISIMISC("UP_DOB"))'="" D "RTN","ISIIMPUE",117,0) . . I ISIMISC("LOW_DOB")>ISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPUE",118,0) . Q "RTN","ISIIMPUE",119,0) Q:EXIT "-1^Invalid LOW_DOB (#200,5)" "RTN","ISIIMPUE",120,0) ; "RTN","ISIIMPUE",121,0) ;-- UP_DOB -- "RTN","ISIIMPUE",122,0) I $G(ISIMISC("UP_DOB"))'="" D "RTN","ISIIMPUE",123,0) . S FIELD=$P(MISCDEF("UP_DOB"),"|",2),VALUE=ISIMISC("UP_DOB") "RTN","ISIIMPUE",124,0) . S Y=VALUE D DD^%DT S VALUE=Y ;Convert to external "RTN","ISIIMPUE",125,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 Q "RTN","ISIIMPUE",126,0) . I $G(ISIMISC("LOW_DOB"))'="" D "RTN","ISIIMPUE",127,0) . . I ISIMISC("LOW_DOB")>ISIMISC("UP_DOB") S EXIT=1 Q "RTN","ISIIMPUE",128,0) . . Q "RTN","ISIIMPUE",129,0) . Q "RTN","ISIIMPUE",130,0) Q:EXIT "-1^Invalid UP_DOB (#200,5)" "RTN","ISIIMPUE",131,0) ; "RTN","ISIIMPUE",132,0) ;-- SSN_MASK -- "RTN","ISIIMPUE",133,0) I $G(ISIMISC("SSN_MASK"))'="" D "RTN","ISIIMPUE",134,0) . S FIELD=4,VALUE=ISIMISC("SSN_MASK") "RTN","ISIIMPUE",135,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUE",136,0) . Q "RTN","ISIIMPUE",137,0) Q:EXIT "-1^Invalid SSN_MASK" "RTN","ISIIMPUE",138,0) ; "RTN","ISIIMPUE",139,0) ;-- CITY -- "RTN","ISIIMPUE",140,0) I $G(ISIMISC("CITY"))'="" D "RTN","ISIIMPUE",141,0) . S FIELD=$P(MISCDEF("CITY"),"|",2),VALUE=ISIMISC("CITY") "RTN","ISIIMPUE",142,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUE",143,0) . Q "RTN","ISIIMPUE",144,0) Q:EXIT "-1^Invalid CITY (#200,.114)" "RTN","ISIIMPUE",145,0) ; "RTN","ISIIMPUE",146,0) ;-- STATE -- "RTN","ISIIMPUE",147,0) I $G(ISIMISC("STATE"))'="" D "RTN","ISIIMPUE",148,0) . S FIELD=$P(MISCDEF("STATE"),"|",2),VALUE=ISIMISC("STATE") "RTN","ISIIMPUE",149,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUE",150,0) . Q "RTN","ISIIMPUE",151,0) Q:EXIT "-1^Invalid STATE (#200,.115)" "RTN","ISIIMPUE",152,0) ; "RTN","ISIIMPUE",153,0) ;ZIP_4_MASK "RTN","ISIIMPUE",154,0) I $G(ISIMISC("ZIP_4_MASK"))'="" D "RTN","ISIIMPUE",155,0) . S FIELD=9,VALUE=ISIMISC("ZIP_4_MASK") "RTN","ISIIMPUE",156,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUE",157,0) . Q "RTN","ISIIMPUE",158,0) Q:EXIT "-1^Invalid ZIP_4_MASK. 5 digits max. Only numbers" "RTN","ISIIMPUE",159,0) ; "RTN","ISIIMPUE",160,0) ;PH_NUM_MASK "RTN","ISIIMPUE",161,0) I $G(ISIMISC("PH_NUM_MASK"))'="" D "RTN","ISIIMPUE",162,0) . S FIELD=10,VALUE=ISIMISC("PH_NUM_MASK") "RTN","ISIIMPUE",163,0) . D CHK^DIE(9001,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUE",164,0) . Q "RTN","ISIIMPUE",165,0) Q:EXIT "-1^Invalid PH_NUM_MASK. Numeric between 0 and 999999" "RTN","ISIIMPUE",166,0) ; "RTN","ISIIMPUE",167,0) ;SERVICE "RTN","ISIIMPUE",168,0) I $G(ISIMISC("SERVICE"))'="" D "RTN","ISIIMPUE",169,0) . S FIELD=$P(MISCDEF("SERVICE"),"|",2),VALUE=ISIMISC("SERVICE") "RTN","ISIIMPUE",170,0) . D CHK^DIE(FILE,FIELD,FLAG,VALUE,.RESULT,.MSG) I RESULT="^" S EXIT=1 "RTN","ISIIMPUE",171,0) . Q "RTN","ISIIMPUE",172,0) Q:EXIT "-1^Invalid SERVICE (#200,29)" "RTN","ISIIMPUE",173,0) ; "RTN","ISIIMPUE",174,0) ;DFN_NAME "RTN","ISIIMPUE",175,0) S X=$E($G(ISIMISC("DFN_NAME"))) S ISIMISC("DFN_NAME")=$S(X="Y":"Y",1:"N") "RTN","ISIIMPUE",176,0) ; "RTN","ISIIMPUE",177,0) ;EMPLOY_STAT "RTN","ISIIMPUE",178,0) I $G(ISIMISC("EMPLOY_STAT"))'="" D "RTN","ISIIMPUE",179,0) . N VALUE S VALUE=$G(ISIMISC("EMPLOY_STAT")) "RTN","ISIIMPUE",180,0) . I VALUE=1!(VALUE="EMPLOYED FULL TIME") S ISIMISC("EMPLOY_STAT")="EMPLOYED FULL TIME" Q "RTN","ISIIMPUE",181,0) . I VALUE=2!(VALUE="EMPLOYED PART TIME") S ISIMISC("EMPLOY_STAT")="EMPLOYED PART TIME" Q "RTN","ISIIMPUE",182,0) . I VALUE=3!(VALUE="NOT EMPLOYED") S ISIMISC("EMPLOY_STAT")="NOT EMPLOYED" Q "RTN","ISIIMPUE",183,0) . I VALUE=4!(VALUE="SELF EMPLOYED") S ISIMISC("EMPLOY_STAT")="SELF EMPLOYED" Q "RTN","ISIIMPUE",184,0) . I VALUE=5!(VALUE="RETIRED") S ISIMISC("EMPLOY_STAT")="RETIRED" Q "RTN","ISIIMPUE",185,0) . I VALUE=6!(VALUE="ACTIVE MILITARY DUTY") S ISIMISC("EMPLOY_STAT")="ACTIVE MILITARY DUTY" Q "RTN","ISIIMPUE",186,0) . I VALUE=9!(VALUE="UNKNOWN") S ISIMISC("EMPLOY_STAT")="UKNOWN:" Q "RTN","ISIIMPUE",187,0) . K ISIMISC("EMPLOY_STAT") "RTN","ISIIMPUE",188,0) . Q "RTN","ISIIMPUE",189,0) ; "RTN","ISIIMPUE",190,0) ;EMAIL_MASK "RTN","ISIIMPUE",191,0) ;USER_MASK "RTN","ISIIMPUE",192,0) ;ESIG_APND "RTN","ISIIMPUE",193,0) ;ACCESS_APND "RTN","ISIIMPUE",194,0) I $G(ISIMISC("ACCESS_APND"))'="" D "RTN","ISIIMPUE",195,0) . N LEN,CHAR,I S EXIT=1 "RTN","ISIIMPUE",196,0) . S LEN=$L(ISIMISC("ACCESS_APND")) F I=1:1:LEN S CHAR=$E(ISIMISC("ACCESS_APND"),I) D "RTN","ISIIMPUE",197,0) . . I CHAR?1N S EXIT=0 Q "RTN","ISIIMPUE",198,0) . . Q "RTN","ISIIMPUE",199,0) . Q "RTN","ISIIMPUE",200,0) Q:EXIT "-1^ACCESS_APND must contain at least one numeric character" "RTN","ISIIMPUE",201,0) ; "RTN","ISIIMPUE",202,0) ; VERIFY_APND "RTN","ISIIMPUE",203,0) ; check for punctuation type character "RTN","ISIIMPUE",204,0) ; "RTN","ISIIMPUE",205,0) Q ISIRC "RTN","ISIIMPUE",206,0) ; "RTN","ISIIMPUF") 0^60^B9623373 "RTN","ISIIMPUF",1,0) ISIIMPUF ;ISI GROUP/MLS -- IMPORT Utility (ADMIT) "RTN","ISIIMPUF",2,0) ;;1.0;;;Jun 26,2012;Build 58 "RTN","ISIIMPUF",3,0) Q "RTN","ISIIMPUF",4,0) ; "RTN","ISIIMPUF",5,0) ; Column definitions for MISCDEF table (below): "RTN","ISIIMPUF",6,0) ; NAME = name of parameter "RTN","ISIIMPUF",7,0) ; TYPE = categories of values provided "RTN","ISIIMPUF",8,0) ; 'PARAM' is internal used value "RTN","ISIIMPUF",9,0) ; 'FIELD' is a literal import value "RTN","ISIIMPUF",10,0) ; 'MASK' is dynamic value w/ * wildcard "RTN","ISIIMPUF",11,0) ; DESC = description of value "RTN","ISIIMPUF",12,0) ; "RTN","ISIIMPUF",13,0) ; Array example: "RTN","ISIIMPUF",14,0) ; MISC(1)="ADATE|T-1@12:00" "RTN","ISIIMPUF",15,0) ; MISC(2)="WARD|3E NORTH" "RTN","ISIIMPUF",16,0) ; MISC(3)="RMBD|3E-100-5" "RTN","ISIIMPUF",17,0) ; MISC(4)="PATIENT|555005555" "RTN","ISIIMPUF",18,0) ; "RTN","ISIIMPUF",19,0) MISCDEF ;;+++++ DEFINITIONS OF ADMIT MISC PARAMETERS +++++ "RTN","ISIIMPUF",20,0) ;;NAME |TYPE |FILE,FIELD |DESC "RTN","ISIIMPUF",21,0) ;;----------------------------------------------------------------- "RTN","ISIIMPUF",22,0) ;;PATIENT |FIELD |2,.02 |PATIENT SSN or IEN "RTN","ISIIMPUF",23,0) ;;PAT_SSN |FIELD |2,.09 |PATIENT (SSN or DFN) "RTN","ISIIMPUF",24,0) ;;ADATE |FIELD | |ADMIT DATE/TIME "RTN","ISIIMPUF",25,0) ;;DDATE |FIELD | |Disposition DATE/TIME "RTN","ISIIMPUF",26,0) ;;ATYPE |FIELD | |Admission type "RTN","ISIIMPUF",27,0) ;;DTYPE |FIELD | |Disposition Type "RTN","ISIIMPUF",28,0) ;;ADMREG |FIELD | |ADMITTING Regulations "RTN","ISIIMPUF",29,0) ;;PROVIDER |FIELD | |ADMITTING PHYSICIAN "RTN","ISIIMPUF",30,0) ;;FDEXC |FIELD | |Facility Dirctry Exclude "RTN","ISIIMPUF",31,0) ;;FTSPEC |FIELD | |Facility Treat Spec "RTN","ISIIMPUF",32,0) ;;SHDIAG |FIELD | |Brief descr of the diag "RTN","ISIIMPUF",33,0) ;;WARD |FIELD | |ADMITTING WARD "RTN","ISIIMPUF",34,0) ;;RMBD |FIELD | |ADMITTING ROOM BED "RTN","ISIIMPUF",35,0) Q "RTN","ISIIMPUF",36,0) ; "RTN","ISIIMPUF",37,0) ADMMISC(MISC,ISIMISC) "RTN","ISIIMPUF",38,0) ; "RTN","ISIIMPUF",39,0) ;INPUT: "RTN","ISIIMPUF",40,0) ; MISC - raw list values from RPC client "RTN","ISIIMPUF",41,0) ; "RTN","ISIIMPUF",42,0) ;OUTPUT: "RTN","ISIIMPUF",43,0) ; ISIMISC("NAME")=VALUE "RTN","ISIIMPUF",44,0) ; "RTN","ISIIMPUF",45,0) N MISCDEF "RTN","ISIIMPUF",46,0) K ISIMISC "RTN","ISIIMPUF",47,0) D LOADMISC(.MISCDEF) ; Load MISC definition params "RTN","ISIIMPUF",48,0) S ISIRC=$$ADMMISC1("ISIMISC") "RTN","ISIIMPUF",49,0) Q ISIRC ;return code "RTN","ISIIMPUF",50,0) ; "RTN","ISIIMPUF",51,0) ADMMISC1(DSTNODE) "RTN","ISIIMPUF",52,0) N PARAM,VALUE,DATE,RESULT,MSG,EXIT "RTN","ISIIMPUF",53,0) S (EXIT,ISIRC)=0,(I,VALUE)="" "RTN","ISIIMPUF",54,0) F S I=$O(MISC(I)) Q:I="" D Q:EXIT "RTN","ISIIMPUF",55,0) . S PARAM=$$TRIM^XLFSTR($P(MISC(I),U)) Q:PARAM="" "RTN","ISIIMPUF",56,0) . S VALUE=$$TRIM^XLFSTR($P(MISC(I),U,2)) "RTN","ISIIMPUF",57,0) . I '$D(MISCDEF(PARAM)) S ISIRC="-1^Bad parameter title passed: "_PARAM,EXIT=1 Q "RTN","ISIIMPUF",58,0) . I VALUE="" S ISIRC="-1^No data provided for parameter: "_PARAM,EXIT=1 Q "RTN","ISIIMPUF",59,0) . I PARAM["DATE" D "RTN","ISIIMPUF",60,0) . . S DATE=VALUE D DT^DILF("T",DATE,.RESULT,"",.MSG) "RTN","ISIIMPUF",61,0) . . I RESULT<0 S EXIT=1,ISIRC="-1^Invalid date." Q "RTN","ISIIMPUF",62,0) . . I $P(RESULT,".",2)="" S $P(RESULT,".",2)="12" "RTN","ISIIMPUF",63,0) . . S VALUE=RESULT "RTN","ISIIMPUF",64,0) . . Q "RTN","ISIIMPUF",65,0) . I EXIT Q "RTN","ISIIMPUF",66,0) . S PARAM=$S(PARAM="PAT_SSN":"PATIENT",1:PARAM) "RTN","ISIIMPUF",67,0) . S @DSTNODE@(PARAM)=VALUE "RTN","ISIIMPUF",68,0) . Q "RTN","ISIIMPUF",69,0) Q ISIRC ;return code "RTN","ISIIMPUF",70,0) ; "RTN","ISIIMPUF",71,0) LOADMISC(MISCDEF) ; "RTN","ISIIMPUF",72,0) N BUF,FIELD,I,NAME,TYPE "RTN","ISIIMPUF",73,0) K MISCDEF "RTN","ISIIMPUF",74,0) F I=3:1 S BUF=$P($T(MISCDEF+I),";;",2) Q:BUF="" D "RTN","ISIIMPUF",75,0) . S NAME=$$TRIM^XLFSTR($P(BUF,"|")) Q:NAME="" "RTN","ISIIMPUF",76,0) . S TYPE=$$TRIM^XLFSTR($P(BUF,"|",2)) "RTN","ISIIMPUF",77,0) . S FIELD=$$TRIM^XLFSTR($P(BUF,"|",3)) "RTN","ISIIMPUF",78,0) . S MISCDEF(NAME)=TYPE_"|"_FIELD "RTN","ISIIMPUF",79,0) Q "RTN","ISIIMPUF",80,0) ; "RTN","ISIIMPUF",81,0) VALADMIT(ISIMISC) "RTN","ISIIMPUF",82,0) ; "RTN","ISIIMPUF",83,0) N EXIT S EXIT="" "RTN","ISIIMPUF",84,0) ; "RTN","ISIIMPUF",85,0) ;overload to allow DFN or SSN "RTN","ISIIMPUF",86,0) S DFN=$G(ISIMISC("PATIENT")) "RTN","ISIIMPUF",87,0) I $O(^DPT("SSN",DFN,0)) S DFN=$O(^DPT("SSN",DFN,0)) ;give priority to SSN "RTN","ISIIMPUF",88,0) I '$D(^DPT(DFN,0)) Q "-1^No entry found for PATIENT (#2)" "RTN","ISIIMPUF",89,0) S ISIMISC("PATIENT")=DFN "RTN","ISIIMPUF",90,0) ; "RTN","ISIIMPUF",91,0) S ADATE=$G(ISIMISC("ADATE")) I $P(ADATE,".",2)="" Q "-1^Missing/invalid time for admit." "RTN","ISIIMPUF",92,0) ; "RTN","ISIIMPUF",93,0) ; facility "RTN","ISIIMPUF",94,0) S ISIFAC=+$$SITE^VASITE() "RTN","ISIIMPUF",95,0) I 'ISIFAC S ISIFAC=$G(ISIMISC("ISIFAC")) "RTN","ISIIMPUF",96,0) I 'ISIFAC Q "-1^Cannot determine FACILITY IEN (Admit)." "RTN","ISIIMPUF",97,0) ; "RTN","ISIIMPUF",98,0) ; -- WARD -- "RTN","ISIIMPUF",99,0) S ISIWARD=$G(ISIMISC("WARD")) "RTN","ISIIMPUF",100,0) I ISIWARD,$D(^DIC(42,ISIWARD,0)) S ISIWARD=$P($G(^DIC(42,ISIWARD,0)),U) "RTN","ISIIMPUF",101,0) S Y=$O(^DIC(42,"B",ISIWARD,0)) I 'Y Q "-1^Invalid WARD (#42)." "RTN","ISIIMPUF",102,0) S (ISIWARDIEN,ISIMISC("WARD"))=Y "RTN","ISIIMPUF",103,0) ; "RTN","ISIIMPUF",104,0) N ISC,IDT,RDT S ISC=$$GET1^DIQ(42,Y,44,"I") "RTN","ISIIMPUF",105,0) S IDT=$P($G(^SC(ISC,"I")),U) "RTN","ISIIMPUF",106,0) S RDT=$P($G(^SC(ISC,"I")),U,2) "RTN","ISIIMPUF",107,0) I IDT'="" I RDT="" I IDTIDT I RDT>DATE Q "-1^WARD location inactive on admit date (#42)." "RTN","ISIIMPUF",109,0) I RDT'="" I RDT0 D "RTN","ISIIMPUG",83,0) . W !,"+++BEFORE Validated array (VALHF^ISIIMPUG)+++",! "RTN","ISIIMPUG",84,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",85,0) . W !,"" R X:5 "RTN","ISIIMPUG",86,0) . Q "RTN","ISIIMPUG",87,0) S ISIRC=$$CHECKENC(.ISIMISC) I ISIRC<0 Q ISIRC "RTN","ISIIMPUG",88,0) N HFACTOR S HFACTOR=$G(ISIMISC("HFACTOR")) "RTN","ISIIMPUG",89,0) S HFACTOR=$O(^AUTTHF("B",HFACTOR,"")) "RTN","ISIIMPUG",90,0) I 'HFACTOR Q "-1^ ~ Missing Health Factor" "RTN","ISIIMPUG",91,0) S ISIMISC("HFACTOR")=HFACTOR "RTN","ISIIMPUG",92,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",93,0) . W !,"+++AFTER Validations array (VALHF^ISIIMPUG)+++",! "RTN","ISIIMPUG",94,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",95,0) . W !,"" R X:5 "RTN","ISIIMPUG",96,0) . Q "RTN","ISIIMPUG",97,0) N ALLOWDUPS S ALLOWDUPS=+$G(ISIMISC("ALLOWDUPS")) "RTN","ISIIMPUG",98,0) I 'ALLOWDUPS,$D(^AUPNVHF("AD",$E(VIEN,1,30))) D "RTN","ISIIMPUG",99,0) . N HFIEN S HFIEN=0 F S HFIEN=$O(^AUPNVHF("AD",$E(VIEN,1,30),HFIEN)) Q:'HFIEN!EXIT D "RTN","ISIIMPUG",100,0) . . I +$G(^AUPNVHF(HFIEN,0))=HFACTOR S EXIT=HFIEN "RTN","ISIIMPUG",101,0) . Q "RTN","ISIIMPUG",102,0) I EXIT Q "-9^HF/VISIT combo already exists" "RTN","ISIIMPUG",103,0) Q 1 "RTN","ISIIMPUG",104,0) ; "RTN","ISIIMPUG",105,0) VALIMZ() ;V IMMUNIZATION Validation "RTN","ISIIMPUG",106,0) N ISIRC,IZ,IZIEN,VIEN,EXIT "RTN","ISIIMPUG",107,0) S (EXIT,ISIRC)=0 "RTN","ISIIMPUG",108,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",109,0) . W !,"+++BEFORE Validated array (VALIMZ^ISIIMPUG)+++",! "RTN","ISIIMPUG",110,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",111,0) . W !,"" R X:5 "RTN","ISIIMPUG",112,0) . Q "RTN","ISIIMPUG",113,0) S ISIRC=$$CHECKENC(.ISIMISC) I ISIRC<0 Q ISIRC "RTN","ISIIMPUG",114,0) ; "RTN","ISIIMPUG",115,0) S IZ=$G(ISIMISC("IZ")) S IZIEN=$O(^AUTTIMM("B",IZ,0)) "RTN","ISIIMPUG",116,0) I 'IZIEN Q "-1^Missing valid Immunization" "RTN","ISIIMPUG",117,0) S ISIMISC("IZ")=IZIEN "RTN","ISIIMPUG",118,0) ; "RTN","ISIIMPUG",119,0) N ALLOWDUPS S ALLOWDUPS=+$G(ISIMISC("ALLOWDUPS")) "RTN","ISIIMPUG",120,0) I 'ALLOWDUPS,$D(^AUPNVIMM("AD",$E(VIEN,1,30))) D "RTN","ISIIMPUG",121,0) . N IMIEN S IMIEN=0 F S IMIEN=$O(^AUPNVIMM("AD",$E(VIEN,1,30),IMIEN)) Q:'IMIEN!EXIT D "RTN","ISIIMPUG",122,0) . . I +$G(^AUPNVIMM(IMIEN,0))=IZIEN S EXIT=IMIEN "RTN","ISIIMPUG",123,0) . Q "RTN","ISIIMPUG",124,0) I EXIT Q "-9^IZ/VISIT combo already exists" "RTN","ISIIMPUG",125,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",126,0) . W !,"+++AFTER Validations array (VALIMZ^ISIIMPUG)+++",! "RTN","ISIIMPUG",127,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",128,0) . W !,"" R X:5 "RTN","ISIIMPUG",129,0) . Q "RTN","ISIIMPUG",130,0) ; "RTN","ISIIMPUG",131,0) Q 1 "RTN","ISIIMPUG",132,0) ; "RTN","ISIIMPUG",133,0) VALCPT() "RTN","ISIIMPUG",134,0) N ISIRC,CPT,CPTIEN,VIEN,PRVNAR,PRVNARI,EXIT "RTN","ISIIMPUG",135,0) S (EXIT,ISIRC)=0 "RTN","ISIIMPUG",136,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",137,0) . W !,"+++BEFORE Validated array (VALCPT^ISIIMPUG)+++",! "RTN","ISIIMPUG",138,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",139,0) . W !,"" R X:5 "RTN","ISIIMPUG",140,0) . Q "RTN","ISIIMPUG",141,0) S ISIRC=$$CHECKENC(.ISIMISC) I ISIRC<0 Q ISIRC "RTN","ISIIMPUG",142,0) ; "RTN","ISIIMPUG",143,0) S CPT=$G(ISIMISC("CPT")) S CPTIEN=$O(^ICPT("B",CPT,0)) "RTN","ISIIMPUG",144,0) I 'CPTIEN Q "-1^Missing valid CPT" "RTN","ISIIMPUG",145,0) S ISIMISC("CPT")=CPTIEN "RTN","ISIIMPUG",146,0) ; "RTN","ISIIMPUG",147,0) N ALLOWDUPS S ALLOWDUPS=+$G(ISIMISC("ALLOWDUPS")) "RTN","ISIIMPUG",148,0) I 'ALLOWDUPS,$D(^AUPNVCPT("AD",$E(VIEN,1,30))) D "RTN","ISIIMPUG",149,0) . N ZIEN S ZIEN=0 F S ZIEN=$O(^AUPNVCPT("AD",$E(VIEN,1,30),ZIEN)) Q:'ZIEN!EXIT D "RTN","ISIIMPUG",150,0) . . I +$G(^AUPNVCPT(ZIEN,0))=CPTIEN S EXIT=ZIEN "RTN","ISIIMPUG",151,0) . Q "RTN","ISIIMPUG",152,0) I EXIT Q "-9^CPT/VISIT combo already exists" "RTN","ISIIMPUG",153,0) ; "RTN","ISIIMPUG",154,0) S PRVNAR=$G(ISIMISC("PROVIDER_NARRATIVE")) "RTN","ISIIMPUG",155,0) I $L(PRVNAR)=0 Q "-1^Missing Provider Narrative." "RTN","ISIIMPUG",156,0) S PRVNARI=$O(^AUTNPOV("B",PRVNAR,0)) "RTN","ISIIMPUG",157,0) I 'PRVNARI Q "-1^Missing/invalid Provider Narrative." "RTN","ISIIMPUG",158,0) S ISIMISC("PROVIDER_NARRATIVE")=PRVNARI "RTN","ISIIMPUG",159,0) ; "RTN","ISIIMPUG",160,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",161,0) . W !,"+++AFTER Validations array (VALCPT^ISIIMPUG)+++",! "RTN","ISIIMPUG",162,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",163,0) . W !,"" R X:5 "RTN","ISIIMPUG",164,0) . Q "RTN","ISIIMPUG",165,0) ; "RTN","ISIIMPUG",166,0) Q 1 "RTN","ISIIMPUG",167,0) ; "RTN","ISIIMPUG",168,0) VALEXAM() "RTN","ISIIMPUG",169,0) N ISIRC,EXAM,EXAMIEN,VIEN,EXIT "RTN","ISIIMPUG",170,0) S (EXIT,ISIRC)=0 "RTN","ISIIMPUG",171,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",172,0) . W !,"+++BEFORE Validated array (VALEXAM^ISIIMPUG)+++",! "RTN","ISIIMPUG",173,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",174,0) . W !,"" R X:5 "RTN","ISIIMPUG",175,0) . Q "RTN","ISIIMPUG",176,0) S ISIRC=$$CHECKENC(.ISIMISC) I ISIRC<0 Q ISIRC "RTN","ISIIMPUG",177,0) ; "RTN","ISIIMPUG",178,0) S EXAM=$G(ISIMISC("EXAM")) I EXAM'="" S EXAMIEN=$O(^AUTTEXAM("B",EXAM,0)) "RTN","ISIIMPUG",179,0) I '$G(EXAMIEN) Q "-1^Missing valid EXAM" "RTN","ISIIMPUG",180,0) S ISIMISC("EXAM")=EXAMIEN "RTN","ISIIMPUG",181,0) ; "RTN","ISIIMPUG",182,0) N ALLOWDUPS S ALLOWDUPS=+$G(ISIMISC("ALLOWDUPS")) "RTN","ISIIMPUG",183,0) I 'ALLOWDUPS,$D(^AUPNVXAM("AD",$E(VIEN,1,30))) D "RTN","ISIIMPUG",184,0) . N ZIEN S ZIEN=0 F S ZIEN=$O(^AUPNVXAM("AD",$E(VIEN,1,30),ZIEN)) Q:'ZIEN!EXIT D "RTN","ISIIMPUG",185,0) . . I +$G(^AUPNVXAM(ZIEN,0))=EXAMIEN S EXIT=ZIEN "RTN","ISIIMPUG",186,0) . Q "RTN","ISIIMPUG",187,0) I EXIT Q "-9^EXAM/VISIT combo already exists" "RTN","ISIIMPUG",188,0) ; "RTN","ISIIMPUG",189,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",190,0) . W !,"+++AFTER Validations array (VALEXAM^ISIIMPUG)+++",! "RTN","ISIIMPUG",191,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",192,0) . W !,"" R X:5 "RTN","ISIIMPUG",193,0) . Q "RTN","ISIIMPUG",194,0) ; "RTN","ISIIMPUG",195,0) Q 1 "RTN","ISIIMPUG",196,0) ; "RTN","ISIIMPUG",197,0) VALPOV() "RTN","ISIIMPUG",198,0) N ISIRC,ICD9,IICD9,VIEN,EXIT "RTN","ISIIMPUG",199,0) S (EXIT,ISIRC)=0 "RTN","ISIIMPUG",200,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",201,0) . W !,"+++BEFORE Validated array (VALEXAM^ISIIMPUG)+++",! "RTN","ISIIMPUG",202,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",203,0) . W !,"" R X:5 "RTN","ISIIMPUG",204,0) . Q "RTN","ISIIMPUG",205,0) S ISIRC=$$CHECKENC(.ISIMISC) I ISIRC<0 Q ISIRC "RTN","ISIIMPUG",206,0) ; "RTN","ISIIMPUG",207,0) S ICD9=$G(ISIMISC("ICD9")) S IICD9=$O(^ICD9("AB",ICD9_" ","")) "RTN","ISIIMPUG",208,0) I 'IICD9 Q "-1^Missing valid ICD9 Code" "RTN","ISIIMPUG",209,0) S ISIMISC("ICD9")=IICD9 "RTN","ISIIMPUG",210,0) ; "RTN","ISIIMPUG",211,0) N ALLOWDUPS S ALLOWDUPS=+$G(ISIMISC("ALLOWDUPS")) "RTN","ISIIMPUG",212,0) I 'ALLOWDUPS,$D(^AUPNVPOV("AD",$E(VIEN,1,30))) D "RTN","ISIIMPUG",213,0) . N ZIEN S ZIEN=0 F S ZIEN=$O(^AUPNVPOV("AD",$E(VIEN,1,30),ZIEN)) Q:'ZIEN!EXIT D "RTN","ISIIMPUG",214,0) . . I +$G(^AUPNVPOV(ZIEN,0))=IICD9 S EXIT=ZIEN "RTN","ISIIMPUG",215,0) . Q "RTN","ISIIMPUG",216,0) I EXIT Q "-9^ICD9/VISIT combo already exists" "RTN","ISIIMPUG",217,0) ; "RTN","ISIIMPUG",218,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",219,0) . W !,"+++AFTER Validations array (VALEXAM^ISIIMPUG)+++",! "RTN","ISIIMPUG",220,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",221,0) . W !,"" R X:5 "RTN","ISIIMPUG",222,0) . Q "RTN","ISIIMPUG",223,0) ; "RTN","ISIIMPUG",224,0) Q 1 "RTN","ISIIMPUG",225,0) ; "RTN","ISIIMPUG",226,0) VALVPTED() "RTN","ISIIMPUG",227,0) N ISIRC,ETOPIC,IETOPIC,VIEN,EXIT "RTN","ISIIMPUG",228,0) S (EXIT,ISIRC)=0 "RTN","ISIIMPUG",229,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",230,0) . W !,"+++BEFORE Validated array (VALVPTED^ISIIMPUG)+++",! "RTN","ISIIMPUG",231,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",232,0) . W !,"" R X:5 "RTN","ISIIMPUG",233,0) . Q "RTN","ISIIMPUG",234,0) S ISIRC=$$CHECKENC(.ISIMISC) I ISIRC<0 Q ISIRC "RTN","ISIIMPUG",235,0) ; "RTN","ISIIMPUG",236,0) S ETOPIC=$G(ISIMISC("ED_TOPIC")) S IETOPIC=$O(^AUTTEDT("B",ETOPIC,0)) "RTN","ISIIMPUG",237,0) I 'IETOPIC Q "-1^Missing valid EDUCATION TOPIC" "RTN","ISIIMPUG",238,0) S ISIMISC("ED_TOPIC")=IETOPIC "RTN","ISIIMPUG",239,0) ; "RTN","ISIIMPUG",240,0) N ALLOWDUPS S ALLOWDUPS=+$G(ISIMISC("ALLOWDUPS")) "RTN","ISIIMPUG",241,0) I 'ALLOWDUPS,$D(^AUPNVPED("AD",$E(VIEN,1,30))) D "RTN","ISIIMPUG",242,0) . N ZIEN S ZIEN=0 F S ZIEN=$O(^AUPNVPED("AD",$E(VIEN,1,30),ZIEN)) Q:'ZIEN!EXIT D "RTN","ISIIMPUG",243,0) . . I +$G(^AUPNVPED(ZIEN,0))=IETOPIC S EXIT=ZIEN "RTN","ISIIMPUG",244,0) . Q "RTN","ISIIMPUG",245,0) I EXIT Q "-9^EDUCATION TOPIC/VISIT combo already exists" "RTN","ISIIMPUG",246,0) ; "RTN","ISIIMPUG",247,0) I $G(ISIPARAM("DEBUG"))>0 D "RTN","ISIIMPUG",248,0) . W !,"+++AFTER Validations array (VALEXAM^ISIIMPUG)+++",! "RTN","ISIIMPUG",249,0) . I $D(ISIMISC) S X="" F S X=$O(ISIMISC(X)) Q:X="" W !,$G(ISIMISC(X)) "RTN","ISIIMPUG",250,0) . W !,"" R X:5 "RTN","ISIIMPUG",251,0) . Q "RTN","ISIIMPUG",252,0) Q 1 "RTN","ISIIMPUG",253,0) ; "RTN","ISIIMPUG",254,0) CHECKENC(ISIMISC) "RTN","ISIIMPUG",255,0) N ISIRC S ISIRC=0 "RTN","ISIIMPUG",256,0) ; "RTN","ISIIMPUG",257,0) ;-- PAT_SSN (required) -- "RTN","ISIIMPUG",258,0) I '$D(ISIMISC("PAT_SSN")) Q "-1^Missing Patient SSN (#2,.09)." "RTN","ISIIMPUG",259,0) I $D(ISIMISC("PAT_SSN")) D "RTN","ISIIMPUG",260,0) . S VALUE=ISIMISC("PAT_SSN") I VALUE="" S ISIRC="-1^Invalid PAT_SSN (#2,.09)." Q "RTN","ISIIMPUG",261,0) . I '$D(^DPT("SSN",VALUE)) S ISIRC="-1^Invalid PAT_SSN (#2,.09)." Q "RTN","ISIIMPUG",262,0) . S DFN=$O(^DPT("SSN",VALUE,"")) I DFN="" S ISIRC="-1^Invalid PAT_SSN (#2,.09)." Q "RTN","ISIIMPUG",263,0) . S ISIMISC("DFN")=DFN "RTN","ISIIMPUG",264,0) . Q "RTN","ISIIMPUG",265,0) I +ISIRC<0 Q ISIRC "RTN","ISIIMPUG",266,0) ; "RTN","ISIIMPUG",267,0) ; -- DATETIME (required) -- "RTN","ISIIMPUG",268,0) I '$G(ISIMISC("DATETIME")) Q "-1^Missing Datetime." "RTN","ISIIMPUG",269,0) ; Find Associated Visit for DATETIME "RTN","ISIIMPUG",270,0) S VIEN=$$VISITCHK(ISIMISC("DFN"),ISIMISC("DATETIME")) "RTN","ISIIMPUG",271,0) I 'VIEN Q "-1^Unable to find associated visit." "RTN","ISIIMPUG",272,0) S ISIMISC("VISIT_IEN")=VIEN "RTN","ISIIMPUG",273,0) ; "RTN","ISIIMPUG",274,0) I '$D(ISIMISC("PROVIDER")) Q "-1^Missing Provider (#200)" "RTN","ISIIMPUG",275,0) N PROVIDER S PROVIDER=ISIMISC("PROVIDER") "RTN","ISIIMPUG",276,0) I 'PROVIDER S PROVIDER=$O(^VA(200,"B",PROVIDER,"")) "RTN","ISIIMPUG",277,0) I 'PROVIDER QUIT "-1^ ~ Missing PROVIDER" "RTN","ISIIMPUG",278,0) N PROVNM S PROVNM=$P($G(^VA(200,PROVIDER,0)),U) "RTN","ISIIMPUG",279,0) I '$O(^VA(200,"AK.PROVIDER",PROVNM,"")) Q "-1^ User missing PROVIDER key." "RTN","ISIIMPUG",280,0) S ISIMISC("PROVIDER")=PROVIDER "RTN","ISIIMPUG",281,0) ; "RTN","ISIIMPUG",282,0) Q ISIRC "RTN","ISIIMPUG",283,0) ; "RTN","ISIIMPUG",284,0) VISITCHK(DFN,DATE) "RTN","ISIIMPUG",285,0) ; Grabs a visit ien if one is available "RTN","ISIIMPUG",286,0) ; INPUT = "RTN","ISIIMPUG",287,0) ; DFN is patient dfn "RTN","ISIIMPUG",288,0) ; DATE is datetime "RTN","ISIIMPUG",289,0) ; OUTPUT = "RTN","ISIIMPUG",290,0) ; VIEN is visit ien "RTN","ISIIMPUG",291,0) ; "RTN","ISIIMPUG",292,0) ; Note -- Currently only grabs outpatient. "RTN","ISIIMPUG",293,0) ; Will return a VIEN on same day if time provided is after visit. "RTN","ISIIMPUG",294,0) ; "RTN","ISIIMPUG",295,0) N RVDT "RTN","ISIIMPUG",296,0) S DFN=+$G(DFN) Q:'DFN 0 "RTN","ISIIMPUG",297,0) S DATE=+$G(DATE) Q:'DATE 0 "RTN","ISIIMPUG",298,0) S RVDT=9999999-$P(DATE,".")_"."_$P(DATE,".",2) "RTN","ISIIMPUG",299,0) I '$D(^AUPNVSIT("AA",DFN,RVDT)) S X=$O(^AUPNVSIT("AA",DFN,RVDT),-1) I X S RVDT=X ;try previous visit "RTN","ISIIMPUG",300,0) S VIEN=$O(^AUPNVSIT("AA",DFN,RVDT,"")) I 'VIEN Q 0 "RTN","ISIIMPUG",301,0) ;N VCHK,VIEN S (VIEN,VCHK)=0 F S VCHK=$O(^AUPNVSIT("AA",DFN,RVDT,VCHK)) Q:'VCHK!VIEN D "RTN","ISIIMPUG",302,0) ;. I $P($G(^AUPNVSIT(VCHK,150)),U,2)'=0 Q ;only outpatients "RTN","ISIIMPUG",303,0) ;. S VIEN=VCHK "RTN","ISIIMPUG",304,0) ;. Q "RTN","ISIIMPUG",305,0) ; "RTN","ISIIMPUG",306,0) Q VIEN "SEC","^DIC",9001,9001,0,"AUDIT") @ "SEC","^DIC",9001,9001,0,"DD") @ "SEC","^DIC",9001,9001,0,"DEL") @ "SEC","^DIC",9001,9001,0,"LAYGO") @ "SEC","^DIC",9001,9001,0,"RD") @ "SEC","^DIC",9001,9001,0,"WR") @ "VER") 8.0^22.0 "^DD",9001,9001,0) FIELD^^21^21 "^DD",9001,9001,0,"DDA") N "^DD",9001,9001,0,"DT") 3140602 "^DD",9001,9001,0,"IX","B",9001,.01) "^DD",9001,9001,0,"NM","ISI PT IMPORT TEMPLATE") "^DD",9001,9001,.01,0) NAME^RF^^0;1^K:$L(X)>30!($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 "^DD",9001,9001,16,0) SERVICE^P49'^DIC(49,^0;16^Q "^DD",9001,9001,16,3) Enter SERVICE/SECTION to be used as USER (#200) default value. "^DD",9001,9001,16,21,0) ^^1^1^3140516^ "^DD",9001,9001,16,21,1,0) This value will be used as the default SERVICE/SECTION (#49) value in #200,29 when using the Data Loader to create new user accounts. "^DD",9001,9001,16,"DT") 3140516 "^DD",9001,9001,17,0) EMAIL MASK^F^^0;17^K:$L(X)>20!($L(X)<4) X "^DD",9001,9001,17,3) Type domain value in 'company.com' format to be in User (#200) accounts. "^DD",9001,9001,17,21,0) ^^1^1^3140516^ "^DD",9001,9001,17,21,1,0) Please provide the 'domain' value used to auto-generate emails when using the Data Loader to create/import users. "^DD",9001,9001,17,"DT") 3140516 "^DD",9001,9001,18,0) USER MASK^F^^0;18^K:$L(X)>30!($L(X)<4) X "^DD",9001,9001,18,3) Answer must be 4-30 characters in length. "^DD",9001,9001,18,21,0) ^^1^1^3140521^ "^DD",9001,9001,18,21,1,0) Value for User (#200 NEW PERSON) Name (.01) mask value. For example, "*,USER". "^DD",9001,9001,18,"DT") 3140521 "^DD",9001,9001,19,0) ESIG APPEND^F^^0;19^K:$L(X)>5!($L(X)<1) X "^DD",9001,9001,19,3) Answer must be 1-5 characters in length. "^DD",9001,9001,19,21,0) ^^1^1^3140602^ "^DD",9001,9001,19,21,1,0) Enter chars to append to User's Last Name to generate Electronic Signature. "^DD",9001,9001,19,"DT") 3140602 "^DD",9001,9001,20,0) ACCESS APPEND^F^^0;20^K:$L(X)>5!($L(X)<1) X "^DD",9001,9001,20,3) Answer must be 1-5 characters in length. "^DD",9001,9001,20,21,0) ^^1^1^3140602^ "^DD",9001,9001,20,21,1,0) Enter chars to append to User's Last name to generate Access Code. "^DD",9001,9001,20,"DT") 3140602 "^DD",9001,9001,21,0) VERIFY APPEND^F^^0;21^K:$L(X)>5!($L(X)<2) X "^DD",9001,9001,21,3) Answer must be 2-5 characters in length. "^DD",9001,9001,21,21,0) ^^1^1^3140602^ "^DD",9001,9001,21,21,1,0) Enter characters to append to User's last name to auto-generate Verify Code. "^DD",9001,9001,21,"DT") 3140602 "^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^3140521^^^^ "^DIC",9001,9001,"%D",1,0) Stores default information for Import APIs "^DIC",9001,"B","ISI PT IMPORT TEMPLATE",9001) **END** **END**