EMERGENCY Released SD*5.3*704 SEQ #588 Extracted from mail message **KIDS**:SD*5.3*704^ **INSTALL NAME** SD*5.3*704 "BLD",11394,0) SD*5.3*704^SCHEDULING^0^3190813^y "BLD",11394,4,0) ^9.64PA^40.6^3 "BLD",11394,4,2,0) 2 "BLD",11394,4,2,2,0) ^9.641^2.98^1 "BLD",11394,4,2,2,2.98,0) APPOINTMENT (sub-file) "BLD",11394,4,2,2,2.98,1,0) ^9.6411^30^2 "BLD",11394,4,2,2,2.98,1,29,0) SCHEDULING APPLICATION "BLD",11394,4,2,2,2.98,1,30,0) SCHEDULER NAME "BLD",11394,4,2,222) y^y^p^^^^n^^n "BLD",11394,4,2,224) "BLD",11394,4,40.6,0) 40.6 "BLD",11394,4,40.6,222) y^y^f^^n^^y^o^n "BLD",11394,4,44,0) 44 "BLD",11394,4,44,2,0) ^9.641^44.003^1 "BLD",11394,4,44,2,44.003,0) PATIENT (sub-file) "BLD",11394,4,44,2,44.003,1,0) ^9.6411^400^1 "BLD",11394,4,44,2,44.003,1,400,0) VETERAN VIDEO CALL URL "BLD",11394,4,44,222) y^y^p^^^^n^^n "BLD",11394,4,44,224) "BLD",11394,4,"APDD",2,2.98) "BLD",11394,4,"APDD",2,2.98,29) "BLD",11394,4,"APDD",2,2.98,30) "BLD",11394,4,"APDD",44,44.003) "BLD",11394,4,"APDD",44,44.003,400) "BLD",11394,4,"B",2,2) "BLD",11394,4,"B",40.6,40.6) "BLD",11394,4,"B",44,44) "BLD",11394,6) 7^ "BLD",11394,6.3) 64 "BLD",11394,"ABPKG") n "BLD",11394,"INI") "BLD",11394,"INID") ^n "BLD",11394,"INIT") EN^SDTMP704 "BLD",11394,"KRN",0) ^9.67PA^779.2^20 "BLD",11394,"KRN",.4,0) .4 "BLD",11394,"KRN",.4,"NM",0) ^9.68A^^0 "BLD",11394,"KRN",.401,0) .401 "BLD",11394,"KRN",.401,"NM",0) ^9.68A^^0 "BLD",11394,"KRN",.402,0) .402 "BLD",11394,"KRN",.402,"NM",0) ^9.68A^^0 "BLD",11394,"KRN",.403,0) .403 "BLD",11394,"KRN",.5,0) .5 "BLD",11394,"KRN",.84,0) .84 "BLD",11394,"KRN",3.6,0) 3.6 "BLD",11394,"KRN",3.8,0) 3.8 "BLD",11394,"KRN",9.2,0) 9.2 "BLD",11394,"KRN",9.8,0) 9.8 "BLD",11394,"KRN",9.8,"NM",0) ^9.68A^18^12 "BLD",11394,"KRN",9.8,"NM",4,0) SDHL7CON^^0^B108890103 "BLD",11394,"KRN",9.8,"NM",5,0) SDTMBUS^^0^B30769228 "BLD",11394,"KRN",9.8,"NM",6,0) SDHL7UL^^0^B60504057 "BLD",11394,"KRN",9.8,"NM",7,0) SDM1A^^0^B133660852 "BLD",11394,"KRN",9.8,"NM",11,0) SDTMPHLA^^0^B121959808 "BLD",11394,"KRN",9.8,"NM",12,0) SDTMPHLB^^0^B46065382 "BLD",11394,"KRN",9.8,"NM",13,0) SDTMP704^^0^B46513744 "BLD",11394,"KRN",9.8,"NM",14,0) SDHL7APT^^0^B250668355 "BLD",11394,"KRN",9.8,"NM",15,0) SDHL7APU^^0^B268564203 "BLD",11394,"KRN",9.8,"NM",16,0) SDHLAPT1^^0^B192619176 "BLD",11394,"KRN",9.8,"NM",17,0) SDTMP08^^0^B208934197 "BLD",11394,"KRN",9.8,"NM",18,0) SDHLAPT2^^0^B22091553 "BLD",11394,"KRN",9.8,"NM","B","SDHL7APT",14) "BLD",11394,"KRN",9.8,"NM","B","SDHL7APU",15) "BLD",11394,"KRN",9.8,"NM","B","SDHL7CON",4) "BLD",11394,"KRN",9.8,"NM","B","SDHL7UL",6) "BLD",11394,"KRN",9.8,"NM","B","SDHLAPT1",16) "BLD",11394,"KRN",9.8,"NM","B","SDHLAPT2",18) "BLD",11394,"KRN",9.8,"NM","B","SDM1A",7) "BLD",11394,"KRN",9.8,"NM","B","SDTMBUS",5) "BLD",11394,"KRN",9.8,"NM","B","SDTMP08",17) "BLD",11394,"KRN",9.8,"NM","B","SDTMP704",13) "BLD",11394,"KRN",9.8,"NM","B","SDTMPHLA",11) "BLD",11394,"KRN",9.8,"NM","B","SDTMPHLB",12) "BLD",11394,"KRN",19,0) 19 "BLD",11394,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",11394,"KRN",19,"NM",1,0) SD EDIT TELE HEALTH STOP CODES^^0 "BLD",11394,"KRN",19,"NM","B","SD EDIT TELE HEALTH STOP CODES",1) "BLD",11394,"KRN",19.1,0) 19.1 "BLD",11394,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",11394,"KRN",101,0) 101 "BLD",11394,"KRN",101,"NM",0) ^9.68A^28^16 "BLD",11394,"KRN",101,"NM",1,0) TMP QBP-Q13 Event Driver^^0 "BLD",11394,"KRN",101,"NM",2,0) TMP QBP-Q13 Subscriber^^0 "BLD",11394,"KRN",101,"NM",3,0) TMP RTB-K13 Event Driver^^0 "BLD",11394,"KRN",101,"NM",4,0) TMP RTB-K13 Subscriber^^0 "BLD",11394,"KRN",101,"NM",5,0) SD TMP SIU-12 SERVER^^0 "BLD",11394,"KRN",101,"NM",18,0) SD TMP S12 CLIENT SUBSCRIBER^^0 "BLD",11394,"KRN",101,"NM",19,0) SD TMP S12 SERVER EVENT DRIVER^^0 "BLD",11394,"KRN",101,"NM",20,0) SD TMP SIU-S12 CLIENT^^0 "BLD",11394,"KRN",101,"NM",21,0) SD IFS EVENT DRIVER^^0 "BLD",11394,"KRN",101,"NM",22,0) SD IFS SUBSCRIBER^^0 "BLD",11394,"KRN",101,"NM",23,0) SD TMP S15 CLIENT SUBSCRIBER^^0 "BLD",11394,"KRN",101,"NM",24,0) SD TMP S15 SERVER EVENT DRIVER^^0 "BLD",11394,"KRN",101,"NM",25,0) SD TMP SEND CANCEL INTRA^^0 "BLD",11394,"KRN",101,"NM",26,0) SD TMP SEND INTRAFACILITY^^0 "BLD",11394,"KRN",101,"NM",27,0) SD TMP RECEIVE CANCEL INTRA^^0 "BLD",11394,"KRN",101,"NM",28,0) SD TMP RECEIVE INTRAFACILITY^^0 "BLD",11394,"KRN",101,"NM","B","SD IFS EVENT DRIVER",21) "BLD",11394,"KRN",101,"NM","B","SD IFS SUBSCRIBER",22) "BLD",11394,"KRN",101,"NM","B","SD TMP RECEIVE CANCEL INTRA",27) "BLD",11394,"KRN",101,"NM","B","SD TMP RECEIVE INTRAFACILITY",28) "BLD",11394,"KRN",101,"NM","B","SD TMP S12 CLIENT SUBSCRIBER",18) "BLD",11394,"KRN",101,"NM","B","SD TMP S12 SERVER EVENT DRIVER",19) "BLD",11394,"KRN",101,"NM","B","SD TMP S15 CLIENT SUBSCRIBER",23) "BLD",11394,"KRN",101,"NM","B","SD TMP S15 SERVER EVENT DRIVER",24) "BLD",11394,"KRN",101,"NM","B","SD TMP SEND CANCEL INTRA",25) "BLD",11394,"KRN",101,"NM","B","SD TMP SEND INTRAFACILITY",26) "BLD",11394,"KRN",101,"NM","B","SD TMP SIU-12 SERVER",5) "BLD",11394,"KRN",101,"NM","B","SD TMP SIU-S12 CLIENT",20) "BLD",11394,"KRN",101,"NM","B","TMP QBP-Q13 Event Driver",1) "BLD",11394,"KRN",101,"NM","B","TMP QBP-Q13 Subscriber",2) "BLD",11394,"KRN",101,"NM","B","TMP RTB-K13 Event Driver",3) "BLD",11394,"KRN",101,"NM","B","TMP RTB-K13 Subscriber",4) "BLD",11394,"KRN",409.61,0) 409.61 "BLD",11394,"KRN",409.61,"NM",0) ^9.68A^^ "BLD",11394,"KRN",771,0) 771 "BLD",11394,"KRN",771,"NM",0) ^9.68A^14^12 "BLD",11394,"KRN",771,"NM",3,0) TMP SEND CONSULTS^^0 "BLD",11394,"KRN",771,"NM",4,0) TMP GET CONSULTS^^0 "BLD",11394,"KRN",771,"NM",5,0) SD-TMP-OUT^^0 "BLD",11394,"KRN",771,"NM",6,0) SD-TMP-IN^^0 "BLD",11394,"KRN",771,"NM",7,0) SD TMP APPT SEND^^0 "BLD",11394,"KRN",771,"NM",8,0) SD TMP APPT RECEIVE^^0 "BLD",11394,"KRN",771,"NM",9,0) SD TMP IFS RECEIVE^^0 "BLD",11394,"KRN",771,"NM",10,0) SD TMP IFS SEND^^0 "BLD",11394,"KRN",771,"NM",11,0) SD TMP RECEIVE CANCEL INTRA^^0 "BLD",11394,"KRN",771,"NM",12,0) SD TMP RECEIVE INTRAFACILITY^^0 "BLD",11394,"KRN",771,"NM",13,0) SD TMP SEND CANCEL INTRA^^0 "BLD",11394,"KRN",771,"NM",14,0) SD TMP SEND INTRAFACILITY^^0 "BLD",11394,"KRN",771,"NM","B","SD TMP APPT RECEIVE",8) "BLD",11394,"KRN",771,"NM","B","SD TMP APPT SEND",7) "BLD",11394,"KRN",771,"NM","B","SD TMP IFS RECEIVE",9) "BLD",11394,"KRN",771,"NM","B","SD TMP IFS SEND",10) "BLD",11394,"KRN",771,"NM","B","SD TMP RECEIVE CANCEL INTRA",11) "BLD",11394,"KRN",771,"NM","B","SD TMP RECEIVE INTRAFACILITY",12) "BLD",11394,"KRN",771,"NM","B","SD TMP SEND CANCEL INTRA",13) "BLD",11394,"KRN",771,"NM","B","SD TMP SEND INTRAFACILITY",14) "BLD",11394,"KRN",771,"NM","B","SD-TMP-IN",6) "BLD",11394,"KRN",771,"NM","B","SD-TMP-OUT",5) "BLD",11394,"KRN",771,"NM","B","TMP GET CONSULTS",4) "BLD",11394,"KRN",771,"NM","B","TMP SEND CONSULTS",3) "BLD",11394,"KRN",779.2,0) 779.2 "BLD",11394,"KRN",779.2,"NM",0) ^9.68A^2^2 "BLD",11394,"KRN",779.2,"NM",1,0) TMP VIMT^^0 "BLD",11394,"KRN",779.2,"NM",2,0) TMP_OUT^^0 "BLD",11394,"KRN",779.2,"NM","B","TMP VIMT",1) "BLD",11394,"KRN",779.2,"NM","B","TMP_OUT",2) "BLD",11394,"KRN",870,0) 870 "BLD",11394,"KRN",870,"NM",0) ^9.68A^1^1 "BLD",11394,"KRN",870,"NM",1,0) TMP_SEND^^0 "BLD",11394,"KRN",870,"NM","B","TMP_SEND",1) "BLD",11394,"KRN",8989.51,0) 8989.51 "BLD",11394,"KRN",8989.51,"NM",0) ^9.68A^^0 "BLD",11394,"KRN",8989.52,0) 8989.52 "BLD",11394,"KRN",8994,0) 8994 "BLD",11394,"KRN",8994,"NM",0) ^9.68A^^0 "BLD",11394,"KRN","B",.4,.4) "BLD",11394,"KRN","B",.401,.401) "BLD",11394,"KRN","B",.402,.402) "BLD",11394,"KRN","B",.403,.403) "BLD",11394,"KRN","B",.5,.5) "BLD",11394,"KRN","B",.84,.84) "BLD",11394,"KRN","B",3.6,3.6) "BLD",11394,"KRN","B",3.8,3.8) "BLD",11394,"KRN","B",9.2,9.2) "BLD",11394,"KRN","B",9.8,9.8) "BLD",11394,"KRN","B",19,19) "BLD",11394,"KRN","B",19.1,19.1) "BLD",11394,"KRN","B",101,101) "BLD",11394,"KRN","B",409.61,409.61) "BLD",11394,"KRN","B",771,771) "BLD",11394,"KRN","B",779.2,779.2) "BLD",11394,"KRN","B",870,870) "BLD",11394,"KRN","B",8989.51,8989.51) "BLD",11394,"KRN","B",8989.52,8989.52) "BLD",11394,"KRN","B",8994,8994) "BLD",11394,"PRET") "BLD",11394,"QUES",0) ^9.62^^0 "BLD",11394,"REQB",0) ^9.611^1^1 "BLD",11394,"REQB",1,0) SD*5.3*650^2 "BLD",11394,"REQB","B","SD*5.3*650",1) "DATA",40.6,1,0) 111 "DATA",40.6,2,0) 118 "DATA",40.6,3,0) 683 "DATA",40.6,4,0) 901 "DATA",40.6,5,0) 136 "DATA",40.6,6,0) 179 "DATA",40.6,7,0) 189 "DATA",40.6,8,0) 371 "DATA",40.6,9,0) 490 "DATA",40.6,10,0) 491 "DATA",40.6,11,0) 648 "DATA",40.6,12,0) 674 "DATA",40.6,13,0) 685 "DATA",40.6,14,0) 674685 "DATA",40.6,15,0) 684 "DATA",40.6,16,0) 690 "DATA",40.6,17,0) 692 "DATA",40.6,18,0) 693 "DATA",40.6,19,0) 694 "DATA",40.6,20,0) 695 "DATA",40.6,21,0) 696 "DATA",40.6,22,0) 698 "DATA",40.6,23,0) 699 "DATA",40.6,24,0) 708 "DATA",40.6,25,0) 323 "DATA",40.6,26,0) 186 "DATA",40.6,27,0) 185 "DATA",40.6,28,0) 160 "DATA",40.6,29,0) 534 "DATA",40.6,30,0) 697 "DATA",40.6,41,0) 348 "DATA",40.6,42,0) 719 "DATA",40.6,43,0) 184 "DATA",40.6,44,0) 502 "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^y^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^SD "FIA",2,2) 1 "FIA",2,2.98) 1 "FIA",2,2.98,29) "FIA",2,2.98,30) "FIA",40.6) SD TELE HEALTH STOP CODE FILE "FIA",40.6,0) ^SD(40.6, "FIA",40.6,0,0) 40.6 "FIA",40.6,0,1) y^y^f^^n^^y^o^n "FIA",40.6,0,10) "FIA",40.6,0,11) "FIA",40.6,0,"RLRO") "FIA",40.6,0,"VR") 5.3^SD "FIA",40.6,40.6) 0 "FIA",44) HOSPITAL LOCATION "FIA",44,0) ^SC( "FIA",44,0,0) 44I "FIA",44,0,1) y^y^p^^^^n^^n "FIA",44,0,10) "FIA",44,0,11) "FIA",44,0,"RLRO") "FIA",44,0,"VR") 5.3^SD "FIA",44,44) 1 "FIA",44,44.003) 1 "FIA",44,44.003,400) "INIT") EN^SDTMP704 "KRN",19,2922726,-1) 0^1 "KRN",19,2922726,0) SD EDIT TELE HEALTH STOP CODES^EDIT TELE HEALTH STOP CODES^^R^^^^^^^^SCHEDULING^^ "KRN",19,2922726,1,0) ^^2^2^3190109^ "KRN",19,2922726,1,1,0) This option provides users with the ability to add or delete stop codes "KRN",19,2922726,1,2,0) used to identify tele health clinics. "KRN",19,2922726,10.1) Tele Health Stop Code "KRN",19,2922726,20) "KRN",19,2922726,25) EDIT406^SDTMPHLA "KRN",19,2922726,"U") EDIT TELE HEALTH STOP CODES "KRN",101,8597,-1) 0^2 "KRN",101,8597,0) TMP QBP-Q13 Subscriber^^^S^^^^^^^^ "KRN",101,8597,99) 65212,44816 "KRN",101,8597,770) ^TMP SEND CONSULTS^^K13^^^^^^^RTB "KRN",101,8597,771) D PARSEQ13^SDHL7CON "KRN",101,8597,773) 0^0^0 "KRN",101,8598,-1) 0^3 "KRN",101,8598,0) TMP RTB-K13 Event Driver^^^E^^^^^^^^ "KRN",101,8598,770) TMP SEND CONSULTS^^RTB^K13^175^^^AL^NE^2.4^ "KRN",101,8598,775,0) ^101.0775PA^1^1 "KRN",101,8598,775,1,0) 8599 "KRN",101,8598,775,1,"^") TMP RTB-K13 Subscriber "KRN",101,8599,-1) 0^4 "KRN",101,8599,0) TMP RTB-K13 Subscriber^^^S^^^^^^^^ "KRN",101,8599,770) ^TMP GET CONSULTS^^K13^^^^^^^RTB "KRN",101,8599,773) 1^1^0 "KRN",101,8600,-1) 0^1 "KRN",101,8600,0) TMP QBP-Q13 Event Driver^^^E^^^^^^^^ "KRN",101,8600,770) TMP GET CONSULTS^^QBP^Q13^165^^^^^2.4^ "KRN",101,8600,775,0) ^101.0775PA^1^1 "KRN",101,8600,775,1,0) 8597 "KRN",101,8600,775,1,"^") TMP QBP-Q13 Subscriber "KRN",101,8601,-1) 0^18 "KRN",101,8601,0) SD TMP S12 CLIENT SUBSCRIBER^SD TMP SIU CLIENT^^S^^^^^^^^ "KRN",101,8601,1,0) ^^1^1^3181012^^ "KRN",101,8601,1,1,0) HL7 subscriber (client) protocol for receiving SIU-S12 messages. "KRN",101,8601,99) 65212,44816 "KRN",101,8601,770) ^SD-TMP-OUT^^S12^^^^^^^ACK "KRN",101,8601,771) D PROCSIU^SDHL7APT "KRN",101,8601,773) ^1^0 "KRN",101,8602,-1) 0^19 "KRN",101,8602,0) SD TMP S12 SERVER EVENT DRIVER^SD TMP S12 SERVER^^E^^^^^^^^ "KRN",101,8602,1,0) ^^1^1^3180816^ "KRN",101,8602,1,1,0) HL7 event driver (server) protocol for receiving SIU-S12 messages. "KRN",101,8602,99) 65212,44816 "KRN",101,8602,770) SD-TMP-IN^^SIU^S12^101^^^AL^AL^2.4^ "KRN",101,8602,772) "KRN",101,8602,775,0) ^101.0775PA^1^1 "KRN",101,8602,775,1,0) 8601 "KRN",101,8602,775,1,"^") SD TMP S12 CLIENT SUBSCRIBER "KRN",101,8603,-1) 0^20 "KRN",101,8603,0) SD TMP SIU-S12 CLIENT^Receive SIU messages from TMP^^S^^^^^^^^ "KRN",101,8603,1,0) ^^2^2^3180926^ "KRN",101,8603,1,1,0) Receives and processes appointment action messages from Tele Health "KRN",101,8603,1,2,0) Management Platform. "KRN",101,8603,99) 65212,44816 "KRN",101,8603,770) ^SD TMP APPT RECEIVE^^S12^^^TMP_SEND^^^^ACK "KRN",101,8603,771) D PROCSIU^SDHL7APT "KRN",101,8603,773) 0^0^0 "KRN",101,8604,-1) 0^5 "KRN",101,8604,0) SD TMP SIU-12 SERVER^^^E^^^^^^^^ "KRN",101,8604,1,0) ^^1^1^3180926^ "KRN",101,8604,1,1,0) Sends SIU-S12 messages to the Tele Health Management Platform. "KRN",101,8604,770) SD TMP APPT SEND^^SIU^S12^^^^AL^AL^2.4^ "KRN",101,8604,775,0) ^101.0775PA^1^1 "KRN",101,8604,775,1,0) 8603 "KRN",101,8604,775,1,"^") SD TMP SIU-S12 CLIENT "KRN",101,8605,-1) 0^21 "KRN",101,8605,0) SD IFS EVENT DRIVER^SD IFS EVENT^^E^^^^^^^^ "KRN",101,8605,1,0) ^^2^2^3181015^ "KRN",101,8605,1,1,0) The event protocol that is used to send/receive inter facility scheduling "KRN",101,8605,1,2,0) messages for the Tele Health Management Platform (TMP). "KRN",101,8605,99) 65212,44816 "KRN",101,8605,770) SD TMP IFS SEND^^SIU^S12^101^^^NE^AL^2.4^ "KRN",101,8605,772) "KRN",101,8605,775,0) ^101.0775PA^1^1 "KRN",101,8605,775,1,0) 8606 "KRN",101,8605,775,1,"^") SD IFS SUBSCRIBER "KRN",101,8606,-1) 0^22 "KRN",101,8606,0) SD IFS SUBSCRIBER^SD IFS SUBSCRIBER^^S^^^^^^^^ "KRN",101,8606,99) 65212,44816 "KRN",101,8606,770) ^SD TMP IFS RECEIVE^^S12^^^^^^^SIU "KRN",101,8606,771) D PROCSIU^SDHL7APT "KRN",101,8606,773) 0^0^0 "KRN",101,8606,774) Q "KRN",101,8607,-1) 0^23 "KRN",101,8607,0) SD TMP S15 CLIENT SUBSCRIBER^^^S^^^^^^^^ "KRN",101,8607,770) ^SD TMP APPT RECEIVE^^S15^^^TMP_SEND^^^^ACK "KRN",101,8607,771) D PROCSIU^SDHL7APT "KRN",101,8607,773) 0^1^0 "KRN",101,8608,-1) 0^24 "KRN",101,8608,0) SD TMP S15 SERVER EVENT DRIVER^^^E^^^^^^^^ "KRN",101,8608,1,0) ^^2^2^3181106^ "KRN",101,8608,1,1,0) HL7 event driver (server) protocol for receiving S15 appointment "KRN",101,8608,1,2,0) cancelation messages for the Tele Health Management (TMP) application. "KRN",101,8608,770) SD TMP APPT SEND^^SIU^S15^101^^^AL^AL^2.4^ "KRN",101,8608,775,0) ^101.0775PA^1^1 "KRN",101,8608,775,1,0) 8607 "KRN",101,8608,775,1,"^") SD TMP S15 CLIENT SUBSCRIBER "KRN",101,8609,-1) 0^26 "KRN",101,8609,0) SD TMP SEND INTRAFACILITY^^^E^^^^^^^^ "KRN",101,8609,1,0) ^^4^4^3181209^ "KRN",101,8609,1,1,0) This event driver is used to schedule intra facility appointments. An "KRN",101,8609,1,2,0) intra facility appointment is where the provider and patient are at "KRN",101,8609,1,3,0) different clinics but the same facility and an appointment has to be "KRN",101,8609,1,4,0) scheduled in both clinics. "KRN",101,8609,770) SD TMP SEND INTRAFACILITY^^SIU^S12^^^^NE^NE^2.4^ "KRN",101,8609,775,0) ^101.0775PA^1^1 "KRN",101,8609,775,1,0) 8610 "KRN",101,8609,775,1,"^") SD TMP RECEIVE INTRAFACILITY "KRN",101,8610,-1) 0^28 "KRN",101,8610,0) SD TMP RECEIVE INTRAFACILITY^^^S^^^^^^^^ "KRN",101,8610,770) ^SD TMP RECEIVE INTRAFACILITY^^S12^^^^^^^SIU "KRN",101,8610,771) D PROCSIU^SDHL7APT "KRN",101,8611,-1) 0^25 "KRN",101,8611,0) SD TMP SEND CANCEL INTRA^^^E^^^^^^^^ "KRN",101,8611,1,0) ^^4^4^3181209^ "KRN",101,8611,1,1,0) This event driver is used to cancel intra facility appointments. An "KRN",101,8611,1,2,0) intra facility appointment is where the provider and patient are at "KRN",101,8611,1,3,0) different clinics but the same facility and an appointment has to be "KRN",101,8611,1,4,0) scheduled in both clinics. "KRN",101,8611,770) SD TMP SEND CANCEL INTRA^^SIU^S15^^^^NE^NE^2.4^ "KRN",101,8611,775,0) ^101.0775PA^1^1 "KRN",101,8611,775,1,0) 8612 "KRN",101,8611,775,1,"^") SD TMP RECEIVE CANCEL INTRA "KRN",101,8612,-1) 0^27 "KRN",101,8612,0) SD TMP RECEIVE CANCEL INTRA^^^S^^^^^^^^ "KRN",101,8612,770) ^SD TMP RECEIVE CANCEL INTRA^^S15^^^^^^^SIU "KRN",101,8612,771) D PROCSIU^SDHL7APT "KRN",771,305,-1) 0^4 "KRN",771,305,0) TMP GET CONSULTS^a^^^^^USA "KRN",771,306,-1) 0^3 "KRN",771,306,0) TMP SEND CONSULTS^a^^^^^USA "KRN",771,306,"EC") ^~\& "KRN",771,306,"FS") | "KRN",771,307,-1) 0^5 "KRN",771,307,0) SD-TMP-OUT^a^^^^^USA "KRN",771,307,"EC") ~|\& "KRN",771,308,-1) 0^6 "KRN",771,308,0) SD-TMP-IN^a^^^^^USA "KRN",771,309,-1) 0^8 "KRN",771,309,0) SD TMP APPT RECEIVE^a^200^^^^USA "KRN",771,309,"EC") ^~\& "KRN",771,309,"FS") | "KRN",771,310,-1) 0^7 "KRN",771,310,0) SD TMP APPT SEND^a^500^^^^USA "KRN",771,310,"EC") ^~\& "KRN",771,310,"FS") | "KRN",771,311,-1) 0^10 "KRN",771,311,0) SD TMP IFS SEND^a^^^^^USA "KRN",771,311,"EC") ^~\& "KRN",771,311,"FS") | "KRN",771,312,-1) 0^9 "KRN",771,312,0) SD TMP IFS RECEIVE^a^^^^^USA "KRN",771,312,"EC") ^~\& "KRN",771,312,"FS") | "KRN",771,313,-1) 0^14 "KRN",771,313,0) SD TMP SEND INTRAFACILITY^a^^^^^USA "KRN",771,313,"EC") ^~\& "KRN",771,313,"FS") | "KRN",771,314,-1) 0^12 "KRN",771,314,0) SD TMP RECEIVE INTRAFACILITY^a^^^^^USA "KRN",771,314,"EC") ^~\& "KRN",771,314,"FS") | "KRN",771,315,-1) 0^13 "KRN",771,315,0) SD TMP SEND CANCEL INTRA^a^^^^^USA "KRN",771,315,"EC") ^~\& "KRN",771,315,"FS") | "KRN",771,316,-1) 0^11 "KRN",771,316,0) SD TMP RECEIVE CANCEL INTRA^a^^^^^USA "KRN",771,316,"EC") ^~\& "KRN",771,316,"FS") | "KRN",779.2,24,-1) 0^1 "KRN",779.2,24,0) TMP VIMT "KRN",779.2,24,1,0) ^779.21I^1^1 "KRN",779.2,24,1,1,0) QBP^Q13^^^^2.4 "KRN",779.2,24,1,"B","QBP",1) "KRN",779.2,24,1,"D","QBP","Q13",2.4,1) "KRN",779.2,24,2) HEALTH LEVEL SEVEN "KRN",779.2,25,-1) 0^2 "KRN",779.2,25,0) TMP_OUT "KRN",779.2,25,2) HEALTH LEVEL SEVEN "KRN",870,332,-1) 0^1 "KRN",870,332,0) TMP_SEND^TEST CHEYENNE VAMC^TCP^^^^^^^^^^^^^^^^^^10 "KRN",870,332,400) vaausapphsh801.aac.domain.ext^54619^C^^^^^54619^ "MBREQ") 0 "ORD",13,870) 870;13;1;;HLLL^XPDTA1;;HLLLE^XPDIA1;;;HLLLDEL^XPDIA1(%) "ORD",13,870,0) HL LOGICAL LINK "ORD",14,771) 771;14;;;HLAP^XPDTA1;HLAPF1^XPDIA1;HLAPE1^XPDIA1;HLAPF2^XPDIA1;;HLAPDEL^XPDIA1(%) "ORD",14,771,0) HL7 APPLICATION PARAMETER "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "ORD",22,779.2) 779.2;22;1;;HLOAP^XPDTA1;;HLOE^XPDIA1;;; "ORD",22,779.2,0) HLO APPLICATION REGISTRY "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813^2930930 "PKG",16,22,1,"PAH",1,0) 704^3190813^520881755 "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") 12 "RTN","SDHL7APT") 0^14^B250668355^n/a "RTN","SDHL7APT",1,0) SDHL7APT ;MS/TG,PH - TMP HL7 Routine;AUG 17, 2018 "RTN","SDHL7APT",2,0) ;;5.3;Scheduling;**704**;AUG 17, 2018;Build 64 "RTN","SDHL7APT",3,0) ; "RTN","SDHL7APT",4,0) ; Integration Agreements: "RTN","SDHL7APT",5,0) Q "RTN","SDHL7APT",6,0) ; "RTN","SDHL7APT",7,0) PROCSIU ;Process SIU^S12 messages from the "TMP VISTA" Subscriber protocol "RTN","SDHL7APT",8,0) ;ENT ; "RTN","SDHL7APT",9,0) ;EN ; "RTN","SDHL7APT",10,0) ; "RTN","SDHL7APT",11,0) ; This routine and subroutines assume that all VistA HL7 environment "RTN","SDHL7APT",12,0) ; variables are properly initialized and will produce a fatal error "RTN","SDHL7APT",13,0) ; if they are missing. "RTN","SDHL7APT",14,0) ; "RTN","SDHL7APT",15,0) ; The message will be checked to see if it is a valid SIU. If valid - the SIU will process the 1st RGS group "RTN","SDHL7APT",16,0) ; on the current facility. Any subsequent RGS groups will be sent to facilities as specified in AIL.3.4 "RTN","SDHL7APT",17,0) ; In the event the appointment does not file on the remote facility (ie; an AE is received from that remote facility) "RTN","SDHL7APT",18,0) ; an AE (with the appropriate error text) will be returned to HealthShare. "RTN","SDHL7APT",19,0) ; Input: "RTN","SDHL7APT",20,0) ; HL7 environment variables "RTN","SDHL7APT",21,0) ; "RTN","SDHL7APT",22,0) ; Output: "RTN","SDHL7APT",23,0) ; Positive (AA) or negative acknowledgement (AE - with appropriate error text) "RTN","SDHL7APT",24,0) ; "RTN","SDHL7APT",25,0) ; "RTN","SDHL7APT",26,0) ; Integration Agreements: NONE "RTN","SDHL7APT",27,0) ; "RTN","SDHL7APT",28,0) N MSGROOT,DATAROOT,QRY,XMT,ERR,RNAME,IX "RTN","SDHL7APT",29,0) K SDTMPHL "RTN","SDHL7APT",30,0) S (MSGROOT,QRY,XMT,ERR,RNAME)="" "RTN","SDHL7APT",31,0) S U="^" "RTN","SDHL7APT",32,0) ; "RTN","SDHL7APT",33,0) ; Inbound SIU messages are small enough to be held in a local array. "RTN","SDHL7APT",34,0) ; The following lines commented out support use of temporary globals and are "RTN","SDHL7APT",35,0) ; left for debugging purposes. "RTN","SDHL7APT",36,0) ; "RTN","SDHL7APT",37,0) S MSGROOT="SDHL7APT" "RTN","SDHL7APT",38,0) K @MSGROOT "RTN","SDHL7APT",39,0) N EIN "RTN","SDHL7APT",40,0) S EIN=$$FIND1^DIC(101,,,"SD TMP S12 SERVER EVENT DRIVER") "RTN","SDHL7APT",41,0) ; "RTN","SDHL7APT",42,0) D LOADXMT^SDHL7APU(.HL,.XMT) ;Load inbound message information "RTN","SDHL7APT",43,0) K ACKMSG S ACKMSG=$G(HL("MID")) "RTN","SDHL7APT",44,0) S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER" "RTN","SDHL7APT",45,0) ; "RTN","SDHL7APT",46,0) N CNT,SEG "RTN","SDHL7APT",47,0) K @MSGROOT "RTN","SDHL7APT",48,0) D LOADMSG^SDHL7APU(MSGROOT) "RTN","SDHL7APT",49,0) ; "RTN","SDHL7APT",50,0) D PARSEMSG^SDHL7APU(MSGROOT,.HL) "RTN","SDHL7APT",51,0) ; "RTN","SDHL7APT",52,0) N DFN,RET,CNT,PID,PV1,RGS,AIS,AIG,AISNTE,AIP,AIPNTE,INP,SETID,EXTIME,SCHNTE,SCH,SDMTC,QRYDFN,MSGCONID,LST,MYRESULT,HLA,PTIEN,SCPER,ATYPIEN "RTN","SDHL7APT",53,0) N AIGNTE,AIL,AILNTE,ARSETE,CURDTTM,ERROR,FLMNFMT,GRPCNT,GRPNO,OBX,PREVSEG,PTIEN,SCHDFN,SCPERC,SDDDT,SDECATID,SDUSER,CHILD "RTN","SDHL7APT",54,0) N SDECCR,SDECEND,SDECLEN,SDECNOTE,SDECRES,SDECSTART,SDECY,SDEKG,SDEL,SDID,SDLAB,SDMRTC,SDPARENT,SDCHILD,SDECAPTID,SDECDATE,FIRST "RTN","SDHL7APT",55,0) N SDREQBY,SDSVCP,SDSVCPR,SDXRAY,SEGTYPE,SETID,SITE,STA,STATUS,STOP,PROVIEN,ERRCND,ERRSND,ERRTXT,URL,MSH,SDECNOT "RTN","SDHL7APT",56,0) ; "RTN","SDHL7APT",57,0) S (MSGCONID,SCHDFN)="" "RTN","SDHL7APT",58,0) S CNT=1,SETID=1,PREVSEG="",GRPCNT=0,PTIEN="",ERRTXT="",ERRSND="" "RTN","SDHL7APT",59,0) ; "RTN","SDHL7APT",60,0) ; Loop to receive HL7 message segments. "RTN","SDHL7APT",61,0) S ERR=0 "RTN","SDHL7APT",62,0) F Q:'$D(@MSGROOT@(CNT)) Q:ERR D S CNT=CNT+1,PREVSEG=SEGTYPE "RTN","SDHL7APT",63,0) .S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7APT",64,0) .I SEGTYPE="MSH" M MSH=@MSGROOT@(CNT) Q "RTN","SDHL7APT",65,0) .I SEGTYPE="SCH" M SCH=@MSGROOT@(CNT) Q "RTN","SDHL7APT",66,0) .I SEGTYPE="NTE",(PREVSEG="SCH") M SCHNTE=@MSGROOT@(CNT) Q "RTN","SDHL7APT",67,0) .I SEGTYPE="PID" M PID=@MSGROOT@(CNT) Q "RTN","SDHL7APT",68,0) .I SEGTYPE="PV1" M PV1=@MSGROOT@(CNT) Q "RTN","SDHL7APT",69,0) .I SEGTYPE="OBX" M OBX=@MSGROOT@(CNT) Q "RTN","SDHL7APT",70,0) .I SEGTYPE="RGS" D Q "RTN","SDHL7APT",71,0) ..S SETID=$G(@MSGROOT@(CNT,1)) "RTN","SDHL7APT",72,0) ..I +SETID=0 S ERR=1,ERRTXT="Invalid RGS SetID received" Q "RTN","SDHL7APT",73,0) ..M RGS(SETID)=@MSGROOT@(CNT) "RTN","SDHL7APT",74,0) ..S GRPCNT=GRPCNT+1 "RTN","SDHL7APT",75,0) ..Q "RTN","SDHL7APT",76,0) .I SEGTYPE="AIS" M AIS(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",77,0) .I SEGTYPE="NTE",(PREVSEG="AIS") M AISNTE(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",78,0) .I SEGTYPE="AIG" M AIG(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",79,0) .I SEGTYPE="NTE",(PREVSEG="AIG") M AIGNTE(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",80,0) .I SEGTYPE="AIL" M AIL(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",81,0) .I SEGTYPE="NTE",(PREVSEG="AIL") M AILNTE(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",82,0) .I SEGTYPE="AIP" M AIP(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",83,0) .I SEGTYPE="NTE",(PREVSEG="AIP") M AIPNTE(SETID)=@MSGROOT@(CNT) "RTN","SDHL7APT",84,0) .Q "RTN","SDHL7APT",85,0) I $G(AIL(2,4))="R" D ;Check to see if this is an intrafacility rtc order and set the rtc number to null on the second AIL second so both appointments file. "RTN","SDHL7APT",86,0) .I $G(AIL(2,4))=$G(AIL(1,4)) S AIL(2,4)="",AIL(2,4)="" "RTN","SDHL7APT",87,0) ; "RTN","SDHL7APT",88,0) I +ERR D Q "RTN","SDHL7APT",89,0) .S ERR="MSA^1^^100^AE^"_$E(ERRTXT,1,50) "RTN","SDHL7APT",90,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",91,0) .K @MSGROOT "RTN","SDHL7APT",92,0) .Q "RTN","SDHL7APT",93,0) ; "RTN","SDHL7APT",94,0) K SCHNW,INP,PCE,SCPER,ATYPIEN "RTN","SDHL7APT",95,0) ; "RTN","SDHL7APT",96,0) ; Loop to populate MSGARY, INP arrays which are used in ^SDECAR2 (to create appt request) and ^SDEC07 (to create appt) "RTN","SDHL7APT",97,0) N MSGARY,SDCL2,SDCL3 "RTN","SDHL7APT",98,0) D MSH^SDHL7APU(.MSH,.INP,.MSGARY) "RTN","SDHL7APT",99,0) D SCH^SDHL7APU(.SCH,.INP,.MSGARY) "RTN","SDHL7APT",100,0) D SCHNTE^SDHL7APU(.SCHNTE,.INP,.MSGARY) "RTN","SDHL7APT",101,0) D PID^SDHL7APU(.PID,.INP,.MSGARY) "RTN","SDHL7APT",102,0) D PV1^SDHL7APU(.PV1,.INP,.MSGARY) "RTN","SDHL7APT",103,0) D OBX^SDHL7APU(.OBX,.INP) "RTN","SDHL7APT",104,0) F IX=1:1:GRPCNT D "RTN","SDHL7APT",105,0) .D RGS^SDHL7APU(.RGS,IX,.INP) "RTN","SDHL7APT",106,0) .D AIS^SDHL7APU(.AIS,IX,.INP,.MSGARY) "RTN","SDHL7APT",107,0) .D AISNTE^SDHL7APU(.AISNTE,IX,.INP) "RTN","SDHL7APT",108,0) .D AIG^SDHL7APU(.AIG,IX,.INP) "RTN","SDHL7APT",109,0) .D AIGNTE^SDHL7APU(.AIGNTE,IX,.INP) "RTN","SDHL7APT",110,0) .D AIL^SDHL7APU(.AIL,IX,.INP,.MSGARY) "RTN","SDHL7APT",111,0) .D AILNTE^SDHL7APU(.AILNTE,IX,.INP) "RTN","SDHL7APT",112,0) .D AIP^SDHL7APU(.AIP,IX,.INP,.MSGARY) "RTN","SDHL7APT",113,0) .D AIPNTE^SDHL7APU(.AIPNTE,IX,.INP) "RTN","SDHL7APT",114,0) .Q "RTN","SDHL7APT",115,0) N %,NOW "RTN","SDHL7APT",116,0) D NOW^%DTC S CURDTTM=$$TMCONV^SDHLAPT2(%) "RTN","SDHL7APT",117,0) S NOW=$$HTFM^XLFDT($H),INP(3)=$$FMTE^XLFDT(NOW) "RTN","SDHL7APT",118,0) S INP(11)=INP(3) "RTN","SDHL7APT",119,0) S INP(5)="APPT" "RTN","SDHL7APT",120,0) S INP(8)="FUTURE" "RTN","SDHL7APT",121,0) ; "RTN","SDHL7APT",122,0) N X11 S X11=$P($G(SDAPTYP),"|") S:$G(X11)="" X11="A" "RTN","SDHL7APT",123,0) S INP(9)=$S(X11="A":"PATIENT",1:"PROVIDER") ;request by provider or patient. RTC orders and consults will always be PROVIDER otherwise it is PATIENT "RTN","SDHL7APT",124,0) ; "RTN","SDHL7APT",125,0) K DFN "RTN","SDHL7APT",126,0) S (DFN,INP(2),MSGARY("DFN"))=$$GETDFN^MPIF001(MSGARY("MPI")) "RTN","SDHL7APT",127,0) I $P(DFN,U,2)="NO ICN"!($P(DFN,U,2)="ICN NOT IN DATABASE") D Q "RTN","SDHL7APT",128,0) .S ERR="MSA^1^^100^AE^PATIENT ICN NOT FOUND" "RTN","SDHL7APT",129,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",130,0) .K @MSGROOT "RTN","SDHL7APT",131,0) .Q "RTN","SDHL7APT",132,0) ; "RTN","SDHL7APT",133,0) N STOPME "RTN","SDHL7APT",134,0) I $P($G(SDAPTYP),"|",1)="C"!($P($G(SDAPTYP),"|",1)="R") D CHKCON^SDHLAPT2(DFN,SDAPTYP) I $G(STOPME)=1 Q "RTN","SDHL7APT",135,0) ; "RTN","SDHL7APT",136,0) I $G(SDCL)="" D Q "RTN","SDHL7APT",137,0) .S ERR="MSA^1^^100^AE^CLINIC ID IS NULL",STOPME=1 "RTN","SDHL7APT",138,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",139,0) .K @MSGROOT "RTN","SDHL7APT",140,0) .Q "RTN","SDHL7APT",141,0) ; "RTN","SDHL7APT",142,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",143,0) ; "RTN","SDHL7APT",144,0) I '$D(^SC($G(SDCL),0)) D Q "RTN","SDHL7APT",145,0) .S ERR="MSA^1^^100^AE^NOT A CLINIC AT THIS SITE" "RTN","SDHL7APT",146,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",147,0) .K @MSGROOT "RTN","SDHL7APT",148,0) .Q "RTN","SDHL7APT",149,0) ; "RTN","SDHL7APT",150,0) K INP D INP^SDHL7APU "RTN","SDHL7APT",151,0) ; "RTN","SDHL7APT",152,0) S RET="" "RTN","SDHL7APT",153,0) ;I a regular appt, not rtc or consult check to see if the appointment is in 409.85 "RTN","SDHL7APT",154,0) I $P(SDAPTYP,"|",1)="A" D "RTN","SDHL7APT",155,0) .Q:$$UPPER^SDUL1(MSGARY("HL7EVENT"))'="S12" "RTN","SDHL7APT",156,0) .;D CHKAPT^SDHL7APU(.RET,INP(2),INP(6)) "RTN","SDHL7APT",157,0) .;I $G(RET)>0 S (SDAPTYP,MSGARY("SDAPTYP"))="A|"_$G(RET) "RTN","SDHL7APT",158,0) .;I $G(RET)'>0 S:INP(3)="" INP(3)=DT S RTN=0 D ARSET^SDHLAPT1(.RTN,.INP) S:$P($G(RTN),U,2) (SDAPTYP,MSGARY("SDAPTYP"))="A|"_$P($G(RTN),U,2) "RTN","SDHL7APT",159,0) .S:INP(3)="" INP(3)=DT S RTN=0 D ARSET^SDHLAPT1(.RTN,.INP) S:$P($G(RTN),U,2) (SDAPTYP,MSGARY("SDAPTYP"))="A|"_$P($G(RTN),U,2) "RTN","SDHL7APT",160,0) I $G(SDMTC)=1 D CHKCHILD^SDHL7APU ; if multi check to see if the child order is in 409.85, if not add it "RTN","SDHL7APT",161,0) ; "RTN","SDHL7APT",162,0) S MSGARY("SDECEND")="" "RTN","SDHL7APT",163,0) S MSGARY("SDDDT")=$TR($G(MSGARY("SDDDT")),"-","") "RTN","SDHL7APT",164,0) N TMPSTART "RTN","SDHL7APT",165,0) S FLMNFMT=$$CONVTIME^SDHL7APU(MSGARY("SDECSTART")),TMPSTART=FLMNFMT,MSGARY("SDECSTART")=$$FMTE^XLFDT(FLMNFMT) "RTN","SDHL7APT",166,0) I FLMNFMT<1 D Q "RTN","SDHL7APT",167,0) .S ERR="MSA^1^^100^AE^Invalid Start Date sent" "RTN","SDHL7APT",168,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",169,0) .K @MSGROOT "RTN","SDHL7APT",170,0) .Q "RTN","SDHL7APT",171,0) ; "RTN","SDHL7APT",172,0) I $L(MSGARY("SDECLEN")),$L(MSGARY("SDECLENUNITS")) D "RTN","SDHL7APT",173,0) .I MSGARY("SDECLENUNITS")="MIN" S MSGARY("SDECEND")=$$FMADD^XLFDT(FLMNFMT,,,MSGARY("SDECLEN")) "RTN","SDHL7APT",174,0) .I MSGARY("SDECLENUNITS")="HR" S MSGARY("SDECEND")=$$FMADD^XLFDT(FLMNFMT,,MSGARY("SDECLEN")) "RTN","SDHL7APT",175,0) .Q "RTN","SDHL7APT",176,0) ; "RTN","SDHL7APT",177,0) N TMPARR,LEN "RTN","SDHL7APT",178,0) S LEN=0 "RTN","SDHL7APT",179,0) S ERRSND=0 "RTN","SDHL7APT",180,0) S ERRTXT="" "RTN","SDHL7APT",181,0) S MSGROOT="SDTMPHL" "RTN","SDHL7APT",182,0) K @MSGROOT "RTN","SDHL7APT",183,0) ; Loop to send RGS>1 groups to remote facilities. Abort entire SIU if any facility returns AE from remote. "RTN","SDHL7APT",184,0) N INTRA S INTRA=0 "RTN","SDHL7APT",185,0) F GRPNO=2:1:GRPCNT D Q:+ERRSND "RTN","SDHL7APT",186,0) .K @MSGROOT "RTN","SDHL7APT",187,0) .S CNT=1 "RTN","SDHL7APT",188,0) .I $D(SCH) S:$G(FCHILD)>0 SCH(7,1,4)=FCHILD S @MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.SCH,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) K FCHILD "RTN","SDHL7APT",189,0) .I $D(SCHNTE) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.SCHNTE,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",190,0) .I $D(PID) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PID,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",191,0) .I $D(PV1) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PV1,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",192,0) .M TMPARR=RGS(GRPNO) "RTN","SDHL7APT",193,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",194,0) .K TMPARR "RTN","SDHL7APT",195,0) .M TMPARR=AIS(GRPNO) "RTN","SDHL7APT",196,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",197,0) .K TMPARR "RTN","SDHL7APT",198,0) .M TMPARR=AISNTE(GRPNO) "RTN","SDHL7APT",199,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",200,0) .K TMPARR "RTN","SDHL7APT",201,0) .M TMPARR=AIG(GRPNO) "RTN","SDHL7APT",202,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",203,0) .K TMPARR "RTN","SDHL7APT",204,0) .M TMPARR=AIL(GRPNO) "RTN","SDHL7APT",205,0) .I $D(TMPARR) D "RTN","SDHL7APT",206,0) ..S MSGARY("INSTIEN")=$G(TMPARR(3,1,4)) "RTN","SDHL7APT",207,0) ..S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",208,0) .K TMPARR "RTN","SDHL7APT",209,0) .M TMPARR=AILNTE(GRPNO) "RTN","SDHL7APT",210,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",211,0) .K TMPARR "RTN","SDHL7APT",212,0) .M TMPARR=AIP(GRPNO) "RTN","SDHL7APT",213,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",214,0) .K TMPARR "RTN","SDHL7APT",215,0) .M TMPARR=AIPNTE(GRPNO) "RTN","SDHL7APT",216,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",217,0) .K TMPARR "RTN","SDHL7APT",218,0) .I MSGARY("INSTIEN")=MSGARY("HLTHISSITE") S INTRA=1 "RTN","SDHL7APT",219,0) .I INTRA=1 D NEWTIME^SDHLAPT2 "RTN","SDHL7APT",220,0) .N HLRESLT,X "RTN","SDHL7APT",221,0) .I INTRA=0 D "RTN","SDHL7APT",222,0) ..I '$$CHKLL^HLUTIL($G(MSGARY("INSTIEN"))) D Q "RTN","SDHL7APT",223,0) ...S ERRSND=1,ERRTXT=$E("Invalid Link assoc with institution: "_$G(MSGARY("INSTIEN")),1,48) "RTN","SDHL7APT",224,0) ..Q "RTN","SDHL7APT",225,0) .K HLA,HLEVN "RTN","SDHL7APT",226,0) .N MC,HLFS,HLCS "RTN","SDHL7APT",227,0) .N IXX "RTN","SDHL7APT",228,0) .F IXX=1:1:CNT S HLA("HLS",IXX)=$G(@MSGROOT@(IXX)) "RTN","SDHL7APT",229,0) .M HLA("HLA")=HLA("HLS") "RTN","SDHL7APT",230,0) .S EIN=$$FIND1^DIC(101,,,"SD IFS EVENT DRIVER") "RTN","SDHL7APT",231,0) .;the following HL* variables are created by DIRECT^HLMA "RTN","SDHL7APT",232,0) .N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN "RTN","SDHL7APT",233,0) .N HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQ "RTN","SDHL7APT",234,0) .N HLQUITQ,SDLINK,OROK,MSASEG,ERRRSP "RTN","SDHL7APT",235,0) .; "RTN","SDHL7APT",236,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",237,0) ..K HL "RTN","SDHL7APT",238,0) ..D:$G(INTRA)=0 INIT^HLFNC2("SD IFS EVENT DRIVER",.HL) "RTN","SDHL7APT",239,0) ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND INTRAFACILITY",.HL) ;if intra "RTN","SDHL7APT",240,0) ..Q "RTN","SDHL7APT",241,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",242,0) ..K HL "RTN","SDHL7APT",243,0) ..D:$G(INTRA)=0 INIT^HLFNC2("SD TMP S15 SERVER EVENT DRIVER",.HL) "RTN","SDHL7APT",244,0) ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND CANCEL INTRA",.HL) ;if intra "RTN","SDHL7APT",245,0) ..Q "RTN","SDHL7APT",246,0) .S SITE=MSGARY("INSTIEN") "RTN","SDHL7APT",247,0) .S STA=$$STA^XUAF4(SITE) "RTN","SDHL7APT",248,0) .S:$G(STA)="" STA=+$G(AIL(2,3,1,4)) "RTN","SDHL7APT",249,0) .D LINK^HLUTIL3(STA,.SDLINK,"I") "RTN","SDHL7APT",250,0) .S SDLINK=$O(SDLINK(0)) "RTN","SDHL7APT",251,0) .I SDLINK="" D Q "RTN","SDHL7APT",252,0) ..Q:$G(INTRA)=1 "RTN","SDHL7APT",253,0) ..S ERRSND=1,ERRTXT=$E("Message link undefined for facility: "_$G(MSGARY("INSTIEN")),1,48) "RTN","SDHL7APT",254,0) ..Q "RTN","SDHL7APT",255,0) .S SDLINK=SDLINK(SDLINK) "RTN","SDHL7APT",256,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",257,0) ..S:$G(INTRA)=0 HLL("LINKS",1)="SD IFS SUBSCRIBER"_U_$G(SDLINK) "RTN","SDHL7APT",258,0) ..S:$G(INTRA)=1 HLL("LINKS",1)="SD TMP RECEIVE INTRAFACILITY"_U_$G(SDLINK) "RTN","SDHL7APT",259,0) ..Q "RTN","SDHL7APT",260,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",261,0) ..S:$G(INTRA)=0 HLL("LINKS",1)="SD TMP S15 CLIENT SUBSCRIBER"_U_$G(SDLINK) "RTN","SDHL7APT",262,0) ..S:$G(INTRA)=1 HLL("LINKS",1)="SD TMP RECEIVE CANCEL INTRA"_U_$G(SDLINK) "RTN","SDHL7APT",263,0) ..Q "RTN","SDHL7APT",264,0) .S HLMTIEN="" "RTN","SDHL7APT",265,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",266,0) ..D:$G(INTRA)=0 DIRECT^HLMA("SD IFS EVENT DRIVER","LM",1,.OROK) ;GENERATE /SD IFS EVENT DRIVER/////SD TMP S12 CLIENT SUBSCRIBER TOMS CODE "RTN","SDHL7APT",267,0) ..D:$G(INTRA)=1 GENERATE^HLMA("SD TMP SEND INTRAFACILITY","LM",1,.OROK) S HLMTIEN=+OROK ;GENERATE /SD IFS EVENT DRIVER/////SD TMP S12 CLIENT SUBSCRIBER TOMS CODE "RTN","SDHL7APT",268,0) ..Q "RTN","SDHL7APT",269,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",270,0) ..D:$G(INTRA)=0 DIRECT^HLMA("SD TMP S15 SERVER EVENT DRIVER","LM",1,.OROK) ;GENERATE /SD IFS EVENT DRIVER/////SD TMP S12 CLIENT SUBSCRIBER "RTN","SDHL7APT",271,0) ..D:$G(INTRA)=1 GENERATE^HLMA("SD TMP SEND CANCEL INTRA","LM",1,.OROK) S HLMTIEN=+OROK ;GENERATE /SD IFS EVENT DRIVER/////SD TMP S12 CLIENT SUBSCRIBER "RTN","SDHL7APT",272,0) ..Q "RTN","SDHL7APT",273,0) .I 'HLMTIEN D Q "RTN","SDHL7APT",274,0) ..S ERRSND=1,ERRTXT=$E("Message sent to remote facility unsuccessful: "_$G(MSGARY("INSTIEN")),1,48) "RTN","SDHL7APT",275,0) ..Q "RTN","SDHL7APT",276,0) .K @MSGROOT "RTN","SDHL7APT",277,0) .;Process response "RTN","SDHL7APT",278,0) .I $G(INTRA)=0 D "RTN","SDHL7APT",279,0) ..N HLNODE,SEG,I,RESP,IK "RTN","SDHL7APT",280,0) ..;H 2 "RTN","SDHL7APT",281,0) ..F IK=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7APT",282,0) ...S RESP(IK)=HLNODE "RTN","SDHL7APT",283,0) ...Q "RTN","SDHL7APT",284,0) ..S MSASEG=$G(RESP(2)) "RTN","SDHL7APT",285,0) ..I $E(MSASEG,1,3)="MSA",$P(MSASEG,"|",2)="AE" S ERRSND=1,ERRTXT=$$STRIP^SDHL7APU($P(MSASEG,"|",4)),ERRTXT=$E(ERRTXT,1,50) "RTN","SDHL7APT",286,0) .Q "RTN","SDHL7APT",287,0) ; "RTN","SDHL7APT",288,0) I +ERRSND D Q "RTN","SDHL7APT",289,0) .S ERR="MSA^1^^100^AE^"_ERRTXT "RTN","SDHL7APT",290,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",291,0) .K @MSGROOT "RTN","SDHL7APT",292,0) .Q "RTN","SDHL7APT",293,0) K @MSGROOT "RTN","SDHL7APT",294,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APT",295,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APT",296,0) N SDSVCP,SDSVCPR,SDEKG,SDXRAY,SDCL,SDECRES,SDAPTYP,APPTYPE,EESTAT,SDPARENT,SDEL,OVB,SDECY,SDECLEN,SDREQBY,SDSVCP,APPTYPE,SDDDT,SDCL "RTN","SDHL7APT",297,0) S SDSVCP="" "RTN","SDHL7APT",298,0) S SDSVCPR="" "RTN","SDHL7APT",299,0) S (SDEKG,SDXRAY)="" "RTN","SDHL7APT",300,0) S SDCL=$G(MSGARY("SDCL")) "RTN","SDHL7APT",301,0) D RESLKUP^SDHL7APU(SDCL) "RTN","SDHL7APT",302,0) S:$G(RET1) SDECRES=RET1 "RTN","SDHL7APT",303,0) S APPTYPE="",EESTAT="",SDPARENT="",SDEL="",MSGARY("SDECCR")="",MSGARY("OVB")=1,(MSGARY("SDEKG"),MSGARY("SDXRAY"))="" "RTN","SDHL7APT",304,0) S MSGARY("SDECRES")=$$RESLKUP^SDHL7APU($G(MSGARY("SDCL"))) "RTN","SDHL7APT",305,0) S (MSGARY("SDEKG"),MSGARY("SDXRAY"))="",(MSGARY("SDEL"),MSGARY("EESTAT"),MSGARY("APPTYPE"),MSGARY("SDLAB"),MSGARY("SDECCR"),MSGARY("SDID"))="",(MSGARY("SDSVCP"),MSGARY("SDSVCPR"))="" "RTN","SDHL7APT",306,0) S SDECY="",SDECSTART=MSGARY("SDECSTART"),SDECEND=MSGARY("SDECEND"),DFN=MSGARY("DFN"),SDECRES=MSGARY("SDECRES"),SDECLEN=MSGARY("SDECLEN"),SDECNOTE=MSGARY("SDECNOTE"),SDECATID=MSGARY("SDECATID") "RTN","SDHL7APT",307,0) S (SDMRTC,MSGARY("SDMRTC"))=$S($G(SDMRTC)=1:"TRUE",1:"FALSE"),SDREQBY=MSGARY("SDREQBY"),SDLAB=MSGARY("SDLAB"),PROVIEN=MSGARY("PROVIEN"),SDID=MSGARY("SDID") ;,SDAPTYP=MSGARY("SDAPTYP") "RTN","SDHL7APT",308,0) S SDSVCP=MSGARY("SDSVCP"),SDSVCPR=MSGARY("SDSVCPR"),SDCL=MSGARY("SDCL"),SDEKG=MSGARY("SDEKG"),SDXRAY=MSGARY("SDXRAY") "RTN","SDHL7APT",309,0) S APPTYPE=MSGARY("APPTYPE"),EESTAT=MSGARY("EESTAT"),OVB=MSGARY("OVB"),SDPARENT=$G(MSGARY("SDPARENT")),SDEL=MSGARY("SDEL"),SDECCR="" "RTN","SDHL7APT",310,0) S SDDDT=$G(MSGARY("SDDDT")),SDAPTYP=$G(MSGARY("SDAPTYP")) "RTN","SDHL7APT",311,0) I $P(SDAPTYP,"|",1)="R" D "RTN","SDHL7APT",312,0) .S $P(SDAPTYP,"|",1)="A" "RTN","SDHL7APT",313,0) .I $P(SDAPTYP,"|",2)=$G(SDPARENT) S:$P($G(^SDEC(409.85,$G(SDPARENT),3)),"^")="" SDPARENT="" "RTN","SDHL7APT",314,0) ; "RTN","SDHL7APT",315,0) K INP D INP^SDHL7APU "RTN","SDHL7APT",316,0) S (ERRCND,ERRTXT)="" "RTN","SDHL7APT",317,0) N SUCCESS "RTN","SDHL7APT",318,0) S SUCCESS=0 "RTN","SDHL7APT",319,0) S (PROVIEN,DUZ)=$G(MSGARY("DUZ")) "RTN","SDHL7APT",320,0) S:$G(DUZ)="" (PROVIEN,DUZ)=.5 "RTN","SDHL7APT",321,0) S:$G(DUZ(2))="" DUZ(2)=$G(MSGARY("HLTHISSITE")) "RTN","SDHL7APT",322,0) I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",323,0) .S URL=MSGARY("AILNTE") "RTN","SDHL7APT",324,0) .S:$P($G(SDAPTYP),"|",1)="R" $P(SDAPTYP,"|",1)="A" "RTN","SDHL7APT",325,0) .I ($P($G(SDAPTYP),"|")="A"&($P($G(SDAPTYP),"|",2)="")) S $P(SDAPTYP,"|",2)=$G(SDCHILD) "RTN","SDHL7APT",326,0) .S:$P($G(SDAPTYP),"|")="" SDAPTYP="A|"_$G(SDCHILD) "RTN","SDHL7APT",327,0) .D APPADD^SDEC07(.SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT,SDEL) ;ADD NEW APPOINTMENT "RTN","SDHL7APT",328,0) .K SDAPT S SDAPT=+$P($G(^TMP("SDEC07",$J,2)),"^") ;if appointment is made this is the appointment number ien from 409.84 "RTN","SDHL7APT",329,0) .S URL=$G(MSGARY("AILNTE")) "RTN","SDHL7APT",330,0) .D:$L(URL) GETAPT^SDHL7APU(URL,SDCL,$G(TMPSTART)) ; If the appointment has been made in SDEC(409,84, update the url in the Hospital Location file. "RTN","SDHL7APT",331,0) .N TMP2 S TMP2=$G(^TMP("SDEC07",$J,2)) "RTN","SDHL7APT",332,0) .I ((+$P(TMP2,"^",1)>0)&($L($P(TMP2,"^",3))<1)) S SUCCESS=1 "RTN","SDHL7APT",333,0) .I SUCCESS=0 S ERRTXT=$P($G(^TMP("SDEC07",$J,2)),"^",3) "RTN","SDHL7APT",334,0) .I ((SUCCESS=0)&(ERRTXT="")) D "RTN","SDHL7APT",335,0) ..S ERRTXT=$P($G(^TMP("SDEC07",$J,3)),"^",2) "RTN","SDHL7APT",336,0) ..Q "RTN","SDHL7APT",337,0) .I $L(ERRTXT) S ERRCND=9999 "RTN","SDHL7APT",338,0) .S DUZ(2)=$G(STA) "RTN","SDHL7APT",339,0) .I $G(SUCCESS)>0 D "RTN","SDHL7APT",340,0) ..N INPA S INPA(1)=$P(SDAPTYP,"|",2),INPA(2)="SA",INPA(3)=$G(DUZ),DUZ(2)=$G(STA) ;INP(1) is the IEN of the PARENT order "RTN","SDHL7APT",341,0) ..S INPA(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",342,0) ..N RET D ARCLOSE^SDECAR(.RET,.INPA) ; Dispositions the order. "RTN","SDHL7APT",343,0) ..N RTN S INP(24)=$G(SDAPT)_"~"_$G(SDCHILD) D ARSET^SDECAR2(.RTN,.INP) ;Update files for RTC orders. "RTN","SDHL7APT",344,0) ..N CLOSEOUT S CLOSEOUT=0 I $G(MSGARY("RTCID"))>0 S:$G(MSGARY("RTCID"))=$P($G(^SDEC(409.85,+$G(SDPARENT),3)),"^",3) CLOSEOUT=1 "RTN","SDHL7APT",345,0) ..I $G(CLOSEOUT)=1 D ;if this is the last child close out the parent and all child orders "RTN","SDHL7APT",346,0) ...N INP S INP(1)=+SDPARENT,INP(2)="SA",INP(3)=$G(DUZ),DUZ(2)=$G(STA) "RTN","SDHL7APT",347,0) ...S INP(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",348,0) ...D ARCLOSE^SDECAR(.RET,.INP) "RTN","SDHL7APT",349,0) ...;Parent Appointment Request Closed now loop thru the 3 node and update each of the children to disposition of "MC" "RTN","SDHL7APT",350,0) ...I $G(SDPARENT)>0 K X12 S X12=0 F S X12=$O(^SDEC(409.85,SDPARENT,2,X12)) Q:X12'>0 D "RTN","SDHL7APT",351,0) ....S INP(1)=$P(^SDEC(409.85,SDPARENT,2,X12,0),"^"),INP(2)="MC",INP(3)=$G(DUZ),DUZ(2)=$G(STA) "RTN","SDHL7APT",352,0) ....S INP(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",353,0) ....D ARCLOSE^SDECAR(.RET,.INP) "RTN","SDHL7APT",354,0) ....Q "RTN","SDHL7APT",355,0) ...;S $P(^SDEC(409.85,+SDPARENT,0),"^",5)="APPT" "RTN","SDHL7APT",356,0) ...Q "RTN","SDHL7APT",357,0) ..Q "RTN","SDHL7APT",358,0) .Q "RTN","SDHL7APT",359,0) ;SECAPPT ; If this is an intrafacility appointment make the second appointment "RTN","SDHL7APT",360,0) I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",361,0) .N XDT,%D,X,Y,SDECTYP,STARTDT "RTN","SDHL7APT",362,0) .S SDECTYP=$G(MSGARY("CSDAPTYP")),SDECNOT=$G(MSGARY("CANREMARKS")),SDECCR="" "RTN","SDHL7APT",363,0) .S SDUSER=$G(MSGARY("DUZ")) "RTN","SDHL7APT",364,0) .S:$G(SDUSER)="" SDUSER=.5 "RTN","SDHL7APT",365,0) .S %DT="RXT",X=SDECSTART D ^%DT S STARTDT=Y "RTN","SDHL7APT",366,0) .S SDECAPTID=$$GETAPP^SDHLAPT1(DFN,SDECRES,STARTDT) "RTN","SDHL7APT",367,0) .S SDECCR=$G(MSGARY("CANCODE")) "RTN","SDHL7APT",368,0) .S DUZ=$G(MSGARY("DUZ")) "RTN","SDHL7APT",369,0) .S:$G(DUZ)="" DUZ=.5 "RTN","SDHL7APT",370,0) .S:$G(DUZ(2))="" DUZ(2)=$G(MSGARY("HLTHISSITE")) "RTN","SDHL7APT",371,0) .D APPDEL^SDEC08(.SDECY,SDECAPTID,SDECTYP,$G(SDECCR),$G(SDECNOT),$G(SDECDATE),$G(SDUSER)) "RTN","SDHL7APT",372,0) .S ERRTXT=$P($G(^TMP("SDEC",$J,2)),"^") "RTN","SDHL7APT",373,0) .I +$L(ERRTXT) S ERRCND=9999 "RTN","SDHL7APT",374,0) .D CHKCAN^SDHLAPT2(DFN,SDCL,STARTDT) "RTN","SDHL7APT",375,0) .;N SDECDA S SDECDA=$G(AIL(1,4)) "RTN","SDHL7APT",376,0) .;S:$G(SDECDA)'="" $P(^SDEC(409.85,SDECDA,0),"^",5)="RTC" "RTN","SDHL7APT",377,0) ; "RTN","SDHL7APT",378,0) I +ERRCND D "RTN","SDHL7APT",379,0) .S ERRTXT=$$ERRLKP^SDHL7APU(ERRTXT) "RTN","SDHL7APT",380,0) .Q "RTN","SDHL7APT",381,0) S ERRTXT=$$STRIP^SDHL7APU(ERRTXT) "RTN","SDHL7APT",382,0) ;S HIT=0,EXTIME="" "RTN","SDHL7APT",383,0) ; "RTN","SDHL7APT",384,0) ;****BUILD THE RESPONSE MSA "RTN","SDHL7APT",385,0) K @MSGROOT "RTN","SDHL7APT",386,0) N HLA "RTN","SDHL7APT",387,0) ; "RTN","SDHL7APT",388,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APT",389,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APT",390,0) ; "RTN","SDHL7APT",391,0) N ERR,LEN S ERR="" "RTN","SDHL7APT",392,0) N FOUNDCN "RTN","SDHL7APT",393,0) S FOUNDCN=0 "RTN","SDHL7APT",394,0) ; "RTN","SDHL7APT",395,0) S HLA("HLA",1)="MSA"_HL("FS")_$S(ERRCND:"AE",1:"AA")_HL("FS")_HL("MID")_HL("FS")_$S(ERRCND:$E(ERRTXT,1,50),1:"")_HL("FS") "RTN","SDHL7APT",396,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7APT",397,0) Q "RTN","SDHL7APU") 0^15^B268564203^n/a "RTN","SDHL7APU",1,0) SDHL7APU ;MS/TG,PH - TMP HL7 Routine;OCT 16, 2018 "RTN","SDHL7APU",2,0) ;;5.3;Scheduling;**704**;AUG 17, 2018;Build 64 "RTN","SDHL7APU",3,0) ; "RTN","SDHL7APU",4,0) ; Integration Agreements: "RTN","SDHL7APU",5,0) Q "RTN","SDHL7APU",6,0) ; "RTN","SDHL7APU",7,0) ;Helper routine to process SIU^S12 messages from the "TMP VISTA" Subscriber protocol "RTN","SDHL7APU",8,0) ; "RTN","SDHL7APU",9,0) MSH(MSH,INP,MSGARY) ; "RTN","SDHL7APU",10,0) S MSGARY("HL7EVENT")=$G(MSH(8,1,2)) "RTN","SDHL7APU",11,0) S MSGARY("HLTHISSITE")=+$G(MSH(5,1,1)) "RTN","SDHL7APU",12,0) Q "RTN","SDHL7APU",13,0) SCH(SCH,INP,MSGARY) ; "RTN","SDHL7APU",14,0) N TM,TMM,CONSDSC,CANCODE "RTN","SDHL7APU",15,0) S SDAPTYP="A|" "RTN","SDHL7APU",16,0) S MSGARY("SDECATID")=$G(SCH(6)) "RTN","SDHL7APU",17,0) S MSGARY("EVENT")=$G(SCH(6,1,1)) ;if the appointment is canceled check for cancel code and cancel reason, they are required "RTN","SDHL7APU",18,0) S (MSGARY("CANCODE"),CANCODE)=$G(SCH(6,1,2)) "RTN","SDHL7APU",19,0) I $G(MSGARY("EVENT"))="CANCELED" D "RTN","SDHL7APU",20,0) . Q:$G(MSGARY("CANCODE"))="" "RTN","SDHL7APU",21,0) . S MSGARY("CANCODE")=$O(^SD(409.2,"B",$G(CANCODE),0)) "RTN","SDHL7APU",22,0) . S:MSGARY("CANCODE")="" MSGARY("CANCODE")=11 "RTN","SDHL7APU",23,0) . S MSGARY("CSDAPTYP")=$G(SCH(6,1,4)) "RTN","SDHL7APU",24,0) S MSGARY("CANREMARKS")=$G(SCH(6,1,5)) "RTN","SDHL7APU",25,0) S MSGARY("CONSID")="" "RTN","SDHL7APU",26,0) S MSGARY("SDECLEN")=$G(SCH(9)) "RTN","SDHL7APU",27,0) S MSGARY("SDECLENUNITS")=$G(SCH(10)) "RTN","SDHL7APU",28,0) S TM=$G(SCH(11,1,4)) "RTN","SDHL7APU",29,0) I $G(SDDDT)="" S:$G(SCH(11,1,8))'="" (MSGARY("SDDDT"),SDDDT)=$G(SCH(11,1,8)) "RTN","SDHL7APU",30,0) I $G(SDDDT)="" S:$G(SCH(5,1,2))'="" (MSGARY("SDDDT"),SDDDT)=$G(SCH(5,1,2)) "RTN","SDHL7APU",31,0) S:$G(TM)'="" MSGARY("SDECSTART")=$P(TM,":",1,2)_":00Z" "RTN","SDHL7APU",32,0) S INP(11)=$G(MSGARY("SDDDT")) "RTN","SDHL7APU",33,0) S MSGARY("SDREQBY")=$G(SCH(16,1,1)) "RTN","SDHL7APU",34,0) N SCHEMAIL S SCHEMAIL=$$LOW^XLFSTR(SCH(13,1,4)) "RTN","SDHL7APU",35,0) S (DUZ,MSGARY("DUZ"))=$O(^VA(200,"ADUPN",$G(SCHEMAIL),"")) "RTN","SDHL7APU",36,0) S:$G(DUZ)'>0 (DUZ,MSGARY("DUZ"))=.5 "RTN","SDHL7APU",37,0) N SDTY S SDTYP=$G(SCH(6,1,4)) "RTN","SDHL7APU",38,0) I $G(SDTYP)="R" D "RTN","SDHL7APU",39,0) .S (MSGARY("RTCID"),SDCHILD)=$G(SCH(7,1,1)),(MSGARY("SDPARENT"),SDPARENT)=$G(SCH(24,1,1)) "RTN","SDHL7APU",40,0) .S:$G(SDCHILD)="" (MSGARY("RTCID"),SDCHILD)=$G(SCH(7,1,4)) "RTN","SDHL7APU",41,0) .S (MSGARY("SDAPTYP"),SDAPTYP)="R|"_$G(SDCHILD) "RTN","SDHL7APU",42,0) .S (SDDDT,MSGARY("SDDDT"))=$P($G(^SDEC(409.85,$G(SDCHILD),0)),"^",16) "RTN","SDHL7APU",43,0) .S:$P($G(^SDEC(409.85,$G(SDCHILD),3)),"^",1)>0 SDMTC=1 "RTN","SDHL7APU",44,0) .I $G(SDPARENT)>0 S:$P($G(^SDEC(409.85,$G(SDPARENT),3)),"^",1)>0 SDMTC=1 "RTN","SDHL7APU",45,0) S:$G(SDTYP)="" SDTYP="A",(MSGARY("SDAPTYP"),SDAPTYP)="A|" "RTN","SDHL7APU",46,0) S:$G(SDTYP)="A" SDTYP="A",(MSGARY("SDAPTYP"),SDAPTYP)="A|" "RTN","SDHL7APU",47,0) ; "RTN","SDHL7APU",48,0) Q "RTN","SDHL7APU",49,0) SCHNTE(SCHNTE,INP,MSGARY) ; "RTN","SDHL7APU",50,0) ; "RTN","SDHL7APU",51,0) S MSGARY("SDECNOTE")=$G(SCHNTE(3)) "RTN","SDHL7APU",52,0) Q "RTN","SDHL7APU",53,0) PID(PID,INP,MSGARY) ; "RTN","SDHL7APU",54,0) ; "RTN","SDHL7APU",55,0) S MSGARY("MPI")=$G(PID(3,1,1)) "RTN","SDHL7APU",56,0) S DFN=$$GETDFN^MPIF001(MSGARY("MPI")) "RTN","SDHL7APU",57,0) Q "RTN","SDHL7APU",58,0) ; "RTN","SDHL7APU",59,0) PV1(PV1,INP,MSGARY) ; "RTN","SDHL7APU",60,0) Q "RTN","SDHL7APU",61,0) ; "RTN","SDHL7APU",62,0) OBX(OBX,INP) ; "RTN","SDHL7APU",63,0) Q "RTN","SDHL7APU",64,0) ; "RTN","SDHL7APU",65,0) RGS(RGS,CNT,INP) ; "RTN","SDHL7APU",66,0) S:$D(RGS) RGS(CNT,1)=1 "RTN","SDHL7APU",67,0) S MSGARY("FACILITYIEN")=$G(RGS(1,3)) "RTN","SDHL7APU",68,0) Q "RTN","SDHL7APU",69,0) ; "RTN","SDHL7APU",70,0) AIS(AIS,CNT,INP,MSGARY) ; "RTN","SDHL7APU",71,0) S:$D(AIS) AIS(CNT,1)=1 "RTN","SDHL7APU",72,0) Q "RTN","SDHL7APU",73,0) ; "RTN","SDHL7APU",74,0) AISNTE(AISNTE,CNT,INP) ; "RTN","SDHL7APU",75,0) S:$D(AISNTE) AISNTE(CNT,1)=1 "RTN","SDHL7APU",76,0) Q "RTN","SDHL7APU",77,0) ; "RTN","SDHL7APU",78,0) AIG(AIG,CNT,INP) ; "RTN","SDHL7APU",79,0) S:$D(AIG) AIG(CNT,1)=1 "RTN","SDHL7APU",80,0) Q "RTN","SDHL7APU",81,0) ; "RTN","SDHL7APU",82,0) AIGNTE(AIGNTE,CNT,INP) ; "RTN","SDHL7APU",83,0) S:$D(AIGNTE) AIGNTE(CNT,1)=1 "RTN","SDHL7APU",84,0) Q "RTN","SDHL7APU",85,0) ; "RTN","SDHL7APU",86,0) AIL(AIL,CNT,INP,MSGARY) ; "RTN","SDHL7APU",87,0) ; "RTN","SDHL7APU",88,0) S:$D(AIL) AIL(CNT,1)=1 "RTN","SDHL7APU",89,0) N STCREC "RTN","SDHL7APU",90,0) S STCREC="" "RTN","SDHL7APU",91,0) S INP(6)=$G(AIL(1,3,1,1)) "RTN","SDHL7APU",92,0) S (SDCL,MSGARY("SDCL"))=$G(AIL(1,3,1,1)) "RTN","SDHL7APU",93,0) S:$G(AIL(2,3,1,1))'="" SDCL2=$G(AIL(2,3,1,1)) "RTN","SDHL7APU",94,0) S:$G(SDCL2)=$G(SDCL) SDCL3=1 "RTN","SDHL7APU",95,0) S INP(4)=$$NAME^XUAF4(+$G(AIL(1,3,1,4))) "RTN","SDHL7APU",96,0) ;CLINIC STOP CODE "RTN","SDHL7APU",97,0) D GETSTC^SDECCON(.STCREC,$P($G(MSGARY("SDCL")),U,1)) "RTN","SDHL7APU",98,0) I $G(AIL(1,4,1,2))="C" D "RTN","SDHL7APU",99,0) .N XSDDDT,GMRDA "RTN","SDHL7APU",100,0) .S GMRDA=$G(AIL(1,4,1,1)) S:$$LOW^XLFSTR($G(GMRDA))="undefined" GMRDA="" "RTN","SDHL7APU",101,0) .S XSDDDT=$$GET1^DIQ(123,$G(GMRDA)_",",17,"I") S (SDDDT,MSGARY("SDDDT"))=$$FMTE^XLFDT(XSDDDT) "RTN","SDHL7APU",102,0) .S MSGARY("CONSID")=$G(GMRDA),(MSGARY("SDAPTYP"),SDAPTYP)="C|"_$G(GMRDA) "RTN","SDHL7APU",103,0) Q "RTN","SDHL7APU",104,0) AILNTE(AILNTE,CNT,INP) ; "RTN","SDHL7APU",105,0) S:$D(AILNTE) AILNTE(CNT,1)=1 "RTN","SDHL7APU",106,0) S MSGARY("AILNTE")=$G(AILNTE(1,3,2)) "RTN","SDHL7APU",107,0) I MSGARY("AILNTE")="" S MSGARY("AILNTE")=$G(AILNTE(1,3)) "RTN","SDHL7APU",108,0) Q "RTN","SDHL7APU",109,0) ; "RTN","SDHL7APU",110,0) AIP(AIP,CNT,INP,MSGARY) ; "RTN","SDHL7APU",111,0) S:$D(AIP) AIP(CNT,1)=1 "RTN","SDHL7APU",112,0) S MSGARY("PROVIEN")=$G(AIP(1,3)) "RTN","SDHL7APU",113,0) Q "RTN","SDHL7APU",114,0) ; "RTN","SDHL7APU",115,0) AIPNTE(AIPNTE,CNT,INP,MSGARY) ; "RTN","SDHL7APU",116,0) S:$D(AIPNTE) AIPNTE(CNT,1)=1 "RTN","SDHL7APU",117,0) Q "RTN","SDHL7APU",118,0) ; "RTN","SDHL7APU",119,0) CHKCHILD ; "RTN","SDHL7APU",120,0) N MTC,FIRST "RTN","SDHL7APU",121,0) K RTCCLIN "RTN","SDHL7APU",122,0) I $P($G(SDAPTYP),"|",1)="R" D ; if rtc check to see if the child is actually a parent "RTN","SDHL7APU",123,0) .I $G(SDPARENT)="" S:$G(SCH(24,1,1))'="" SDPARENT=$G(SCH(24,1,1)) "RTN","SDHL7APU",124,0) .I $G(SDPARENT)="" S:$G(SCH(23,1,1))'="" SDPARENT=$G(SCH(23,1,1)) "RTN","SDHL7APU",125,0) .;I $G(SDCHILD)=$G(SDPARENT) "RTN","SDHL7APU",126,0) .S:$G(SDPARENT)>0 MTC=$P($G(^SDEC(409.85,+$G(SDPARENT),3)),"^",3),(SDMRTC,MSGARY("SDMRTC"))=$S(MTC>0:"1",1:0) "RTN","SDHL7APU",127,0) .Q:$G(MTC)=0 ; Not a multi RTC "RTN","SDHL7APU",128,0) .S:$G(SDCL)>0 RTCCLIN=$P(^SDEC(409.85,$G(SDPARENT),0),"^",9) "RTN","SDHL7APU",129,0) .S DUZ=$G(MSGARY("DUZ")) "RTN","SDHL7APU",130,0) .Q:$G(RTCCLIN)'=SDCL "RTN","SDHL7APU",131,0) .N X12,X13 S (X12,X13)=0 F S X12=$O(^SDEC(409.85,$G(SDPARENT),2,X12)) Q:X12'>0 S X13=X12 "RTN","SDHL7APU",132,0) .Q:$G(X13)=MTC!($G(X13)>MTC) "RTN","SDHL7APU",133,0) .I $G(MTC)>0 F I=1:1:MTC Q:I>MTC D "RTN","SDHL7APU",134,0) ..S:INP(3)="" INP(3)=DT S INP(25)=SDPARENT,INP(6)=$P(^SDEC(409.85,SDPARENT,0),"^",9),RTN=0 "RTN","SDHL7APU",135,0) ..S INP(5)="RTC",INP(1)="",INP(14)="YES",INP(15)=$P($G(^SDEC(409.85,SDPARENT,3)),"^",2),INP(16)=I "RTN","SDHL7APU",136,0) ..D ARSET^SDHLAPT1(.RTN,.INP) "RTN","SDHL7APU",137,0) ..I I=1 S:$P($G(RTN),"^",2)>0 FCHILD=$P(RTN,"^",2) "RTN","SDHL7APU",138,0) .Q "RTN","SDHL7APU",139,0) Q "RTN","SDHL7APU",140,0) VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message "RTN","SDHL7APU",141,0) ; "RTN","SDHL7APU",142,0) ; Messages handled: SIU^S12 "RTN","SDHL7APU",143,0) ; "RTN","SDHL7APU",144,0) ; SIU query messages must contain QPD and RCP segments "RTN","SDHL7APU",145,0) ; Any additional segments are ignored "RTN","SDHL7APU",146,0) ; "RTN","SDHL7APU",147,0) ; Input: "RTN","SDHL7APU",148,0) ; MSGROOT - Root of array holding message "RTN","SDHL7APU",149,0) ; XMT - Transmission parameters "RTN","SDHL7APU",150,0) ; "RTN","SDHL7APU",151,0) ; Output: "RTN","SDHL7APU",152,0) ; "RTN","SDHL7APU",153,0) ; XMT - Transmission parameters "RTN","SDHL7APU",154,0) ; ERR - segment^sequence^field^code^ACK type^error text "RTN","SDHL7APU",155,0) ; "RTN","SDHL7APU",156,0) N MSH,QPD,REQID,REQTYPE,QTAG,QNAME,RDF "RTN","SDHL7APU",157,0) N SEGTYPE,CNT "RTN","SDHL7APU",158,0) K QRY,ERR "RTN","SDHL7APU",159,0) S ERR="" "RTN","SDHL7APU",160,0) ; "RTN","SDHL7APU",161,0) Q 1 "RTN","SDHL7APU",162,0) ; "RTN","SDHL7APU",163,0) PARSESEG(SEG,DATA,HL) ;Generic segment parser "RTN","SDHL7APU",164,0) ;This procedure parses a single HL7 segment and builds an array "RTN","SDHL7APU",165,0) ;subscripted by the field number containing the data for that field. "RTN","SDHL7APU",166,0) ; Does not handle segments that span nodes "RTN","SDHL7APU",167,0) ; "RTN","SDHL7APU",168,0) ; Input: "RTN","SDHL7APU",169,0) ; SEG - HL7 segment to parse "RTN","SDHL7APU",170,0) ; HL - HL7 environment array "RTN","SDHL7APU",171,0) ; "RTN","SDHL7APU",172,0) ; Output: "RTN","SDHL7APU",173,0) ; Function value - field data array [SUB1:field, SUB2:repetition, "RTN","SDHL7APU",174,0) ; SUB3:component, SUB4:sub-component] "RTN","SDHL7APU",175,0) ; "RTN","SDHL7APU",176,0) N CMP ;component subscript "RTN","SDHL7APU",177,0) N CMPVAL ;component value "RTN","SDHL7APU",178,0) N FLD ;field subscript "RTN","SDHL7APU",179,0) N FLDVAL ;field value "RTN","SDHL7APU",180,0) N REP ;repetition subscript "RTN","SDHL7APU",181,0) N REPVAL ;repetition value "RTN","SDHL7APU",182,0) N SUB ;sub-component subscript "RTN","SDHL7APU",183,0) N SUBVAL ;sub-component value "RTN","SDHL7APU",184,0) N FS ;field separator "RTN","SDHL7APU",185,0) N CS ;component separator "RTN","SDHL7APU",186,0) N RS ;repetition separator "RTN","SDHL7APU",187,0) N SS ;sub-component separator "RTN","SDHL7APU",188,0) ; "RTN","SDHL7APU",189,0) K DATA "RTN","SDHL7APU",190,0) S FS=HL("FS") "RTN","SDHL7APU",191,0) S CS=$E(HL("ECH")) "RTN","SDHL7APU",192,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7APU",193,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7APU",194,0) ; "RTN","SDHL7APU",195,0) S DATA(0)=$P(SEG,FS) "RTN","SDHL7APU",196,0) S SEG=$P(SEG,FS,2,9999) "RTN","SDHL7APU",197,0) ; "RTN","SDHL7APU",198,0) F FLD=1:1:$L(SEG,FS) D "RTN","SDHL7APU",199,0) . S FLDVAL=$P(SEG,FS,FLD) "RTN","SDHL7APU",200,0) . F REP=1:1:$L(FLDVAL,RS) D "RTN","SDHL7APU",201,0) . . S REPVAL=$P(FLDVAL,RS,REP) "RTN","SDHL7APU",202,0) . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D "RTN","SDHL7APU",203,0) . . . S CMPVAL=$P(REPVAL,CS,CMP) "RTN","SDHL7APU",204,0) . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D "RTN","SDHL7APU",205,0) . . . . S SUBVAL=$P(CMPVAL,SS,SUB) "RTN","SDHL7APU",206,0) . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL "RTN","SDHL7APU",207,0) . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL "RTN","SDHL7APU",208,0) . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL "RTN","SDHL7APU",209,0) . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL "RTN","SDHL7APU",210,0) Q "RTN","SDHL7APU",211,0) ; "RTN","SDHL7APU",212,0) PARSEMSG(MSGROOT,HL) ; Message Parser "RTN","SDHL7APU",213,0) ; Does not handle segments that span nodes "RTN","SDHL7APU",214,0) ; Does not handle extremely long segments (uses a local) "RTN","SDHL7APU",215,0) ; Does not handle long fields (segment parser doesn't) "RTN","SDHL7APU",216,0) ; "RTN","SDHL7APU",217,0) N SEG,CNT,DATA,MSG "RTN","SDHL7APU",218,0) F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D "RTN","SDHL7APU",219,0) . D PARSESEG(SEG(0),.DATA,.HL) "RTN","SDHL7APU",220,0) . K @MSGROOT@(CNT) "RTN","SDHL7APU",221,0) . I DATA(0)'="" M @MSGROOT@(CNT)=DATA "RTN","SDHL7APU",222,0) . Q:'$D(SEG(1)) "RTN","SDHL7APU",223,0) . Q "RTN","SDHL7APU",224,0) Q "RTN","SDHL7APU",225,0) ; "RTN","SDHL7APU",226,0) SEND() ; "RTN","SDHL7APU",227,0) Q "RTN","SDHL7APU",228,0) ACKIN ; "RTN","SDHL7APU",229,0) Q "RTN","SDHL7APU",230,0) INP ; set up the INP array for calling ARSET^SDECAR2 to update the RTC orders "RTN","SDHL7APU",231,0) ; Need to add code to add the rtcparent to the HL7 message and to parse it out. "RTN","SDHL7APU",232,0) N NODE3,INTV,NUMAPT,ORDATE "RTN","SDHL7APU",233,0) K INP "RTN","SDHL7APU",234,0) S:$G(MSGARY("PROVIEN"))>0 INP(10)=$$GET1^DIQ(200,$G(MSGARY("PROVIEN"))_",",.01,"E") "RTN","SDHL7APU",235,0) ; "RTN","SDHL7APU",236,0) S PCE="" S PCE=$P($G(^DPT(MSGARY("DFN"),"ENR")),U,1) I PCE'="" D "RTN","SDHL7APU",237,0) .S INP(13)=$$GET1^DIQ(27.11,PCE,.07,"E") "RTN","SDHL7APU",238,0) S:$G(SDMRTC)'="" INP(14)=$S(SDMRTC=1:"YES",SDMRTC=0:"NO",1:"") "RTN","SDHL7APU",239,0) I $G(MSGARY("SDPARENT"))'="" S SDPARENT=$G(MSGARY("SDPARENT")) "RTN","SDHL7APU",240,0) I +$G(SDPARENT)>0 S NODE3=$G(^SDEC(409.85,+SDPARENT,3)),INTV=$P(NODE3,"^",2) "RTN","SDHL7APU",241,0) S INP(1)=$G(SDCHILD) ;If a new RTC order this will be null so it will be added to the file. If this is not null, an update happens "RTN","SDHL7APU",242,0) S INP(2)=$G(DFN) "RTN","SDHL7APU",243,0) D NOW^%DTC S NOW=$$HTFM^XLFDT($H),INP(3)=$$FMTE^XLFDT(NOW) "RTN","SDHL7APU",244,0) ;NEEDS THE TEXT INSTITUTION NAME "RTN","SDHL7APU",245,0) S INP(4)=$$NAME^XUAF4(+$G(DUZ(2))) ;Required, DUZ(2) is the signed on users division they are signed into, +DUZ(2) is the parent station number "RTN","SDHL7APU",246,0) S INP(5)="APPT" "RTN","SDHL7APU",247,0) S INP(6)=$G(SDCL) "RTN","SDHL7APU",248,0) S INP(7)="" ;null for TMP appointments or can we get this from the original RTC order? "RTN","SDHL7APU",249,0) S INP(8)="FUTURE" "RTN","SDHL7APU",250,0) N X11 S X11=$P($G(SDAPTYP),"|") S:$G(X11)="" X11="A" "RTN","SDHL7APU",251,0) S INP(9)=$S(X11="A":"PATIENT",1:"PROVIDER") ;request by provider or patient. RTC orders and consults will always be PROVIDER otherwise it is PATIENT "RTN","SDHL7APU",252,0) S:$G(MSGARY("PROVIEN"))>0 INP(10)=$$GET1^DIQ(200,$G(MSGARY("PROVIEN"))_",",.01,"E") ;Provider name - needs to be in lastname,firstname middle initial. "RTN","SDHL7APU",253,0) S INP(11)=$G(SDDDT) ; Clinically Indicate Date for first appointment in the sequence, each of the remaining appointments have to be calculated "RTN","SDHL7APU",254,0) S:$G(INP(11))="" (INP(11),SDDDT)=$G(SCH(5,1,2)) "RTN","SDHL7APU",255,0) S INP(12)=$G(SDECNOTE) ; RTC comments these are different than the comments that are stored in in file 44 appointment multiple. "RTN","SDHL7APU",256,0) S PCE="" S PCE=$P($G(^DPT(MSGARY("DFN"),"ENR")),U,1) I PCE'="" D "RTN","SDHL7APU",257,0) .S INP(13)=$$GET1^DIQ(27.11,PCE,.07,"E") "RTN","SDHL7APU",258,0) S INP(14)="" "RTN","SDHL7APU",259,0) S:$G(SDMRTC)'="" INP(14)=$S(SDMRTC=1:"YES",SDMRTC=0:"NO",1:"NO") ; SDMRTC=1:YES "RTN","SDHL7APU",260,0) S INP(15)=$G(INTV) ;If MRTC, the interval in days between appointments "RTN","SDHL7APU",261,0) S INP(16)=$G(RTCID) ;If MRTC, the appointment number for this appointment "RTN","SDHL7APU",262,0) S INP(17)="" ;null for TMP "RTN","SDHL7APU",263,0) N SCXX S SCXX=$S($G(SDPARENT)>0:$$GET1^DIQ(409.85,SDPARENT_",",15,"I"),1:0) "RTN","SDHL7APU",264,0) S INP(18)=$S($G(SCXX)=1:"YES",1:"NO") ;is this service connected? we can get this from the parent "RTN","SDHL7APU",265,0) S SCPERC=0 "RTN","SDHL7APU",266,0) S SCPERC=$P(^DPT($G(INP(2)),.3),"^",2) "RTN","SDHL7APU",267,0) S INP(19)=SCPERC "RTN","SDHL7APU",268,0) S INP(22)="9" "RTN","SDHL7APU",269,0) S INP(23)="NEW" "RTN","SDHL7APU",270,0) S:$G(SDCHILD)=$G(SDPARENT) SDPARENT="" "RTN","SDHL7APU",271,0) S INP(25)=$G(SDPARENT) "RTN","SDHL7APU",272,0) S:$G(SDPARENT)>0 INP(28)=$P($G(^SDEC(409.85,+SDPARENT,7)),U,1) ; this is the CPRS order number "RTN","SDHL7APU",273,0) S:$G(INP(28))>0 INP(26)=$P($G(^SDEC(409.85,+SDPARENT,7)),U,2) "RTN","SDHL7APU",274,0) Q "RTN","SDHL7APU",275,0) ARSET(X) ; set the appointment requests into 409.85 "RTN","SDHL7APU",276,0) Q "RTN","SDHL7APU",277,0) S STOP=0 "RTN","SDHL7APU",278,0) I $G(X)'>0 Q STOP "RTN","SDHL7APU",279,0) I $G(^SDEC(409.85,X,0))="" Q STOP "RTN","SDHL7APU",280,0) I $G(^SDEC(409.85,X,3),"^")=1 D ; it is a multiple appointment rtc order "RTN","SDHL7APU",281,0) .S INTV=$P(^SDEC(409.85,X,3),"^",2),NUMAPT=$P(^SDEC(409.85,X,3),"^",3) "RTN","SDHL7APU",282,0) Q "RTN","SDHL7APU",283,0) LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing "RTN","SDHL7APU",284,0) ; "RTN","SDHL7APU",285,0) ;This subroutine assumes that all VistA HL7 environment variables are "RTN","SDHL7APU",286,0) ;properly initialized and will produce a fatal error if they aren't. "RTN","SDHL7APU",287,0) ; "RTN","SDHL7APU",288,0) N CNT,SEG "RTN","SDHL7APU",289,0) K @MSGROOT "RTN","SDHL7APU",290,0) F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7APU",291,0) . S CNT=0 "RTN","SDHL7APU",292,0) . S @MSGROOT@(SEG,CNT)=HLNODE "RTN","SDHL7APU",293,0) . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) "RTN","SDHL7APU",294,0) . Q "RTN","SDHL7APU",295,0) Q "RTN","SDHL7APU",296,0) LOADXMT(HL,XMT) ;Set HL dependent XMT values "RTN","SDHL7APU",297,0) ; "RTN","SDHL7APU",298,0) ; The HL array and variables are expected to be defined. If not, "RTN","SDHL7APU",299,0) ; message processing will fail. These references should not be "RTN","SDHL7APU",300,0) ; wrapped in $G, as null values will simply postpone the failure to "RTN","SDHL7APU",301,0) ; a point that will be harder to diagnose. Except HL("APAT") which "RTN","SDHL7APU",302,0) ; is not defined on synchronous calls. "RTN","SDHL7APU",303,0) ; "RTN","SDHL7APU",304,0) ; Integration Agreements: "RTN","SDHL7APU",305,0) ; 1373 : Reference to PROTOCOL file #101 "RTN","SDHL7APU",306,0) ; "RTN","SDHL7APU",307,0) N SUBPROT,RESPIEN,RESP0 "RTN","SDHL7APU",308,0) ;S HL("EID")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7APU",309,0) ;S HL("EIDS")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Subscriber") "RTN","SDHL7APU",310,0) S HL("EID")=$$FIND1^DIC(101,,,"SD TMP S12 SERVER EVENT DRIVER") "RTN","SDHL7APU",311,0) S HL("EIDS")=$$FIND1^DIC(101,,,"SD TMP S12 CLIENT SUBSCRIBER") "RTN","SDHL7APU",312,0) ;S HLL("LINKS",1)="SD IFS SUBSCRIBER^TMP_SEND" "RTN","SDHL7APU",313,0) S XMT("MID")=HL("MID") ;Message ID "RTN","SDHL7APU",314,0) S XMT("MODE")="A" ;Response mode "RTN","SDHL7APU",315,0) I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode "RTN","SDHL7APU",316,0) S XMT("MESSAGE TYPE")=HL("MTN") ;Message type "RTN","SDHL7APU",317,0) S XMT("EVENT TYPE")=HL("ETN") ;Event type "RTN","SDHL7APU",318,0) S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters "RTN","SDHL7APU",319,0) ;S XMT("DELIM")="~^\&" "RTN","SDHL7APU",320,0) S XMT("MAX SIZE")=0 ;Default size unlimited "RTN","SDHL7APU",321,0) ; "RTN","SDHL7APU",322,0) ; Map response protocol and builder "RTN","SDHL7APU",323,0) S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") "RTN","SDHL7APU",324,0) Q "RTN","SDHL7APU",325,0) ERRLKP(ERRTXT) ; "RTN","SDHL7APU",326,0) N ERTXI,ERTX1,ERTX2,X,XSP,ERTXT "RTN","SDHL7APU",327,0) S ERTXT=ERRTXT "RTN","SDHL7APU",328,0) S XSP=0 "RTN","SDHL7APU",329,0) F ERTXI=1:1 S X=$P($TEXT(ERRS+ERTXI),";;",2) Q:X="" Q:XSP D "RTN","SDHL7APU",330,0) . S ERTX1=$P(X,"^",1) "RTN","SDHL7APU",331,0) . S ERTX2=$P(X,"^",2) "RTN","SDHL7APU",332,0) . I ERTX1'="",ERTX2'="" I ERTXT[ERTX1 S ERTXT=ERTX2,XSP=1 "RTN","SDHL7APU",333,0) . Q "RTN","SDHL7APU",334,0) Q ERTXT "RTN","SDHL7APU",335,0) CONVTIME(TIME) ;Intrinsic Function. Convert XML time to FileMan format "RTN","SDHL7APU",336,0) ;ZEXCEPT: %DT ;environment variable "RTN","SDHL7APU",337,0) N X,XD,XOUT,XT,XZ,Y,%DT "RTN","SDHL7APU",338,0) S XZ=0 I $G(TIME)["Z" S XZ=1 ;Zulu time (GMT) "RTN","SDHL7APU",339,0) S XD=$P($G(TIME),"T",1) ;Date "RTN","SDHL7APU",340,0) S XD=$P(XD,"-",2)_"/"_$P(XD,"-",3)_"/"_$P(XD,"-",1) ;Convert date to MM/DD/YYYY "RTN","SDHL7APU",341,0) S XT=$P($G(TIME),"T",2) ;Time "RTN","SDHL7APU",342,0) I XZ=1 S XT=$P(XT,"Z",1) ;Strip "Z" from time "RTN","SDHL7APU",343,0) S X=XD_"@"_XT S %DT="RTS" "RTN","SDHL7APU",344,0) D ^%DT S XOUT=Y "RTN","SDHL7APU",345,0) I XZ=1 S XOUT=$$FMADD^XLFDT(XOUT,0,+$E($$TZ^XLFDT,1,3),0,0) ;Adjust from GMT "RTN","SDHL7APU",346,0) K %DT(0) "RTN","SDHL7APU",347,0) Q XOUT "RTN","SDHL7APU",348,0) CHKAPT(RET,DFN,CLINID) ; "RTN","SDHL7APU",349,0) N XX,STATUS "RTN","SDHL7APU",350,0) Q:$G(DFN)'>0 "RTN","SDHL7APU",351,0) Q:$G(CLINID)'>0 "RTN","SDHL7APU",352,0) Q:'$D(^DPT(DFN,0)) "RTN","SDHL7APU",353,0) Q:'$D(^SC(CLINID,0)) "RTN","SDHL7APU",354,0) S RET=0,STATUS=0 "RTN","SDHL7APU",355,0) S XX=0 F S XX=$O(^SDEC(409.85,"SCC",DFN,CLINID,XX)) Q:XX'>0 D "RTN","SDHL7APU",356,0) . Q:$G(STATUS)=1 "RTN","SDHL7APU",357,0) . S:$P($G(^SDEC(409.85,XX,"SDAPT")),"^")'="" STATUS=1 "RTN","SDHL7APU",358,0) . S:$P(^SDEC(409.85,XX,0),"^",17)="O" STATUS=1,RET=XX "RTN","SDHL7APU",359,0) Q RET "RTN","SDHL7APU",360,0) STRIP(SDECZ) ;Replace control characters with spaces "RTN","SDHL7APU",361,0) N SDECI "RTN","SDHL7APU",362,0) F SDECI=1:1:$L(SDECZ) I (32>$A($E(SDECZ,SDECI))) S SDECZ=$E(SDECZ,1,SDECI-1)_" "_$E(SDECZ,SDECI+1,999) "RTN","SDHL7APU",363,0) Q SDECZ "RTN","SDHL7APU",364,0) ; "RTN","SDHL7APU",365,0) RESLKUP(CLINID) ; "RTN","SDHL7APU",366,0) ;uses the CLINID to lookup the clinic in the SDEC RESOURCE FILE "RTN","SDHL7APU",367,0) N STOP,XX "RTN","SDHL7APU",368,0) K RET,RET1 "RTN","SDHL7APU",369,0) S RET=0 "RTN","SDHL7APU",370,0) I $G(CLINID)'>0 S RET="0^Invalid Clinic ID" Q "RTN","SDHL7APU",371,0) I '$D(^SC(CLINID,0)) S RET="0^Clinic is not in the Hospital Location file" Q "RTN","SDHL7APU",372,0) S (STOP,XX)=0 F S XX=$O(^SDEC(409.831,"ALOC",CLINID,XX)) Q:XX'>0 D "RTN","SDHL7APU",373,0) . Q:$G(STOP)=1 "RTN","SDHL7APU",374,0) . I $P($G(^SDEC(409.831,XX,0)),"^",11)["SC(" S STOP=1,RET=XX "RTN","SDHL7APU",375,0) S RET1=RET "RTN","SDHL7APU",376,0) Q RET1 "RTN","SDHL7APU",377,0) GETAPT(URL,SDCL,SDECSTART) ; "RTN","SDHL7APU",378,0) N STOP,SNODE,CNODE,XX "RTN","SDHL7APU",379,0) S STOP=0 "RTN","SDHL7APU",380,0) Q:$L(URL)'>0 ;if no url, nothing to do here "RTN","SDHL7APU",381,0) Q:$L(SDCL)'>0 ;SDCL is required "RTN","SDHL7APU",382,0) Q:'$D(^SC(SDCL,0)) ;Clinic doesn't exist "RTN","SDHL7APU",383,0) Q:'$D(^SC(SDCL,"S",SDECSTART)) ; Appointment doesnt' exist "RTN","SDHL7APU",384,0) S XX=0 F S XX=$O(^SC(SDCL,"S",SDECSTART,1,XX)) Q:XX'>0 D ;Get the correct appointment node for the patient "RTN","SDHL7APU",385,0) .I $P(^SC(SDCL,"S",SDECSTART,1,XX,0),"^")=DFN D "RTN","SDHL7APU",386,0) . . S SNODE=$G(^SC(SDCL,"S",SDECSTART,1,XX,0)) "RTN","SDHL7APU",387,0) . . S CNODE=$P($G(^SC(SDCL,"S",SDECSTART,1,XX,"CONS")),"^") "RTN","SDHL7APU",388,0) . . S ^SC(SDCL,"S",SDECSTART,1,XX,"URL")=$G(URL) "RTN","SDHL7APU",389,0) . . S STOP=1 "RTN","SDHL7APU",390,0) Q STOP "RTN","SDHL7APU",391,0) CHKLL(X) ;check setup of Logical Link "RTN","SDHL7APU",392,0) ;input value: X = institution number or name "RTN","SDHL7APU",393,0) ;return value: 1 = setup OK "RTN","SDHL7APU",394,0) ; 0 = LL setup incorrect "RTN","SDHL7APU",395,0) N HLRESLT "RTN","SDHL7APU",396,0) D LINK^HLUTIL3(X,.HLRESLT) "RTN","SDHL7APU",397,0) S X=+$O(HLRESLT(0)) Q:'X 0 "RTN","SDHL7APU",398,0) ; "RTN","SDHL7APU",399,0) Q $$LLOK^HLCSLM(X) "RTN","SDHL7APU",400,0) SENDERR(ERR) ; Send for unsuccessful response "RTN","SDHL7APU",401,0) K @MSGROOT "RTN","SDHL7APU",402,0) N HLA "RTN","SDHL7APU",403,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APU",404,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APU",405,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7APU",406,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7APU",407,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7APU",408,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7APU",409,0) K @MSGROOT "RTN","SDHL7APU",410,0) Q "RTN","SDHL7APU",411,0) DUZ ; send error nak back if user not on system "RTN","SDHL7APU",412,0) S ERR="MSA^1^^100^AE^SCHEDULER NOT AUTHORIZED ON THIS VISTA" "RTN","SDHL7APU",413,0) D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APU",414,0) K @MSGROOT "RTN","SDHL7APU",415,0) Q "RTN","SDHL7APU",416,0) ERRS ; "RTN","SDHL7APU",417,0) ;;already has appt at^Patient already has an appt at that datetime "RTN","SDHL7APU",418,0) ;;already has appt at^Patient already has an appt "RTN","SDHL7APU",419,0) ;;SDEC07 Error: This RTC request has been closed^This RTC request has been closed "RTN","SDHL7APU",420,0) ;;SDEC07 Error: Invalid Start Time^Invalid Start Time "RTN","SDHL7APU",421,0) ;;SDEC07 Error: Invalid End Time^Invalid End Time "RTN","SDHL7APU",422,0) ;;SDEC07: Patient ID required.^Patient ID required "RTN","SDHL7APU",423,0) ;;SDEC07 Error: Invalid Patient ID^Invalid Patient ID "RTN","SDHL7APU",424,0) ;;Patient is being edited. Try again later.^Patient is being edited. "RTN","SDHL7APU",425,0) ;;SDEC07 Error: Invalid Resource ID^Invalid Resource ID "RTN","SDHL7APU",426,0) ;;SDEC07 Error: Unable to add appointment -- invalid Resource entry.^Unable to add appt - invalid Resource entry "RTN","SDHL7APU",427,0) ;;SDEC07 Error: Appointment length must be between 5 - 120.^Appointment length must be between 5 - 120 "RTN","SDHL7APU",428,0) ;;SDEC07 Error: Invalid appointment request type.^Invalid appointment request type "RTN","SDHL7APU",429,0) ;;THAT TIME IS NOT WITHIN SCHEDULED PERIOD^That time not within scheduled period "RTN","SDHL7APU",430,0) ;;SDEC07 Error: Invalid clinic ID.^Invalid clinic ID "RTN","SDHL7APU",431,0) ;;is an inactive clinic.^Clinic is inactive "RTN","SDHL7APU",432,0) ;;Another user is working with this patient's record. Please try again later^Patient record locked "RTN","SDHL7APU",433,0) ;;SDEC07 Error: Unable to add appointment to SDEC APPOINTMENT file.^Can't add appointment to SDEC APPOINTMENT file "RTN","SDHL7APU",434,0) ;;Invalid Clinic ID - Cannot determine if Overbook is allowed.^Cannot determine if Overbook is allowed. "RTN","SDHL7APU",435,0) ;;Invalid Appointment Date.^Invalid Appointment Date. "RTN","SDHL7APU",436,0) ;;SDEC08: Invalid Appointment ID^Invalid Appointment ID "RTN","SDHL7APU",437,0) ;;Error adding date to file 44: Clinic^Error adding date to file 44 "RTN","SDHL7APU",438,0) ;;SDEC08: Invalid status type^Invalid status type "RTN","SDHL7APU",439,0) ;;Another user is working with this patient's record. Please try again later^Patient record locked "RTN","SDHL7APU",440,0) ;;Invalid Appointment ID.^Invalid Appointment ID "RTN","SDHL7APU",441,0) ;;Appointment is not Cancelled.^Appointment is not Cancelled "RTN","SDHL7APU",442,0) ;;Cancelled by patient appointment cannot be uncancelled.^Cannot be uncancelled "RTN","SDHL7APU",443,0) ;;FileMan add toS DPT error: Patient=^FileMan add toS DPT error "RTN","SDHL7APU",444,0) ;;Another user is working with this patient's record. Please try again later^Patient record locked "RTN","SDHL7CON") 0^4^B108890103^n/a "RTN","SDHL7CON",1,0) SDHL7CON ;MS/TG/MS/PB - TMP HL7 Routine;JULY 05, 2018 "RTN","SDHL7CON",2,0) ;;5.3;Scheduling;**704**;May 29, 2018;Build 64 "RTN","SDHL7CON",3,0) ; "RTN","SDHL7CON",4,0) ; Integration Agreements: "RTN","SDHL7CON",5,0) Q "RTN","SDHL7CON",6,0) ; "RTN","SDHL7CON",7,0) PARSEQ13 ;Process QBP^Q13 messages from the "TMP VISTA" Subscriber protocol "RTN","SDHL7CON",8,0) ; "RTN","SDHL7CON",9,0) ; This routine and subroutines assume that all VistA HL7 environment "RTN","SDHL7CON",10,0) ; variables are properly initialized and will produce a fatal error "RTN","SDHL7CON",11,0) ; if they are missing. "RTN","SDHL7CON",12,0) ; "RTN","SDHL7CON",13,0) ; The message will be checked to see if it is a valid query. "RTN","SDHL7CON",14,0) ; If not a negative acknowledgement will be sent. If the query is an "RTN","SDHL7CON",15,0) ; immediate mode or synchronous query, the realtime request manager "RTN","SDHL7CON",16,0) ; is called to handle the query. This means the query will be "RTN","SDHL7CON",17,0) ; processed and a response generated immediately. "RTN","SDHL7CON",18,0) ; In the future deferred mode queries may be filed in a database for "RTN","SDHL7CON",19,0) ; later processing, or transmission. "RTN","SDHL7CON",20,0) ; "RTN","SDHL7CON",21,0) ; Input: "RTN","SDHL7CON",22,0) ; HL7 environment variables "RTN","SDHL7CON",23,0) ; "RTN","SDHL7CON",24,0) ; Output: "RTN","SDHL7CON",25,0) ; Processed query or negative acknowledgement "RTN","SDHL7CON",26,0) ; If handled real-time the query response is generated "RTN","SDHL7CON",27,0) ; "RTN","SDHL7CON",28,0) ; Integration Agreements "RTN","SDHL7CON",29,0) ; "RTN","SDHL7CON",30,0) N MSGROOT,DATAROOT,QRY,XMT,ERR,RNAME,IX "RTN","SDHL7CON",31,0) S (MSGROOT,QRY,XMT,ERR,RNAME)="" "RTN","SDHL7CON",32,0) ; Inbound query messages are small enough to be held in a local. "RTN","SDHL7CON",33,0) ; The following lines commented out support use of global and are "RTN","SDHL7CON",34,0) ; left in case use a global becomes necessary. "RTN","SDHL7CON",35,0) ; "RTN","SDHL7CON",36,0) S MSGROOT="SDHL7MSG" "RTN","SDHL7CON",37,0) K @MSGROOT "RTN","SDHL7CON",38,0) N EIN "RTN","SDHL7CON",39,0) S EIN=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7CON",40,0) ; "RTN","SDHL7CON",41,0) D LOADXMT(.HL,.XMT) ;Load inbound message information "RTN","SDHL7CON",42,0) S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER" "RTN","SDHL7CON",43,0) ; "RTN","SDHL7CON",44,0) N CNT,SEG "RTN","SDHL7CON",45,0) K @MSGROOT "RTN","SDHL7CON",46,0) D LOADMSG(MSGROOT) "RTN","SDHL7CON",47,0) ; "RTN","SDHL7CON",48,0) D PARSEMSG(MSGROOT,.HL) "RTN","SDHL7CON",49,0) ; "RTN","SDHL7CON",50,0) I '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR) D Q "RTN","SDHL7CON",51,0) . D SENDERR(ERR) "RTN","SDHL7CON",52,0) . K @MSGROOT "RTN","SDHL7CON",53,0) . Q "RTN","SDHL7CON",54,0) ; "RTN","SDHL7CON",55,0) N CNT,RDT,HIT,EXTIME,RDF,QPD,QRYDFN,MSGCONID,LST,MYRESULT,HLA,RTCLST "RTN","SDHL7CON",56,0) ; "RTN","SDHL7CON",57,0) S (MSGCONID,QRYDFN)="" "RTN","SDHL7CON",58,0) S CNT=1 "RTN","SDHL7CON",59,0) ; "RTN","SDHL7CON",60,0) F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 "RTN","SDHL7CON",61,0) . S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7CON",62,0) . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT) S QRYDFN=$G(@MSGROOT@(CNT,3)) Q "RTN","SDHL7CON",63,0) . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q "RTN","SDHL7CON",64,0) . I SEGTYPE="MSH" S MSGCONID=$G(@MSGROOT@(CNT,9)) Q "RTN","SDHL7CON",65,0) . Q "RTN","SDHL7CON",66,0) ; "RTN","SDHL7CON",67,0) I QRYDFN="" D Q "RTN","SDHL7CON",68,0) . S ERR="QPD^1^^100^AE^No DFN value sent" "RTN","SDHL7CON",69,0) . D SENDERR(ERR) "RTN","SDHL7CON",70,0) . K @MSGROOT "RTN","SDHL7CON",71,0) . Q "RTN","SDHL7CON",72,0) ; "RTN","SDHL7CON",73,0) I '$D(^DPT(QRYDFN,0)) D Q "RTN","SDHL7CON",74,0) . S ERR="QPD^1^^100^AE^Undefined DFN" "RTN","SDHL7CON",75,0) . D SENDERR(ERR) "RTN","SDHL7CON",76,0) . K @MSGROOT "RTN","SDHL7CON",77,0) . Q "RTN","SDHL7CON",78,0) S DATAROOT=$NA(^TMP("ORQQCN",$J,"CS")) "RTN","SDHL7CON",79,0) K @DATAROOT "RTN","SDHL7CON",80,0) D LIST(.LST,QRYDFN) "RTN","SDHL7CON",81,0) D RTCLIST(.RTCLST,QRYDFN) "RTN","SDHL7CON",82,0) ; "RTN","SDHL7CON",83,0) I '$D(^TMP("ORQQCN",$J,"CS")) D Q "RTN","SDHL7CON",84,0) . S ERR="RDT^1^^100^AA^No consults found" "RTN","SDHL7CON",85,0) . D SENDERR(ERR) "RTN","SDHL7CON",86,0) . K @DATAROOT,@MSGROOT "RTN","SDHL7CON",87,0) . Q "RTN","SDHL7CON",88,0) ; "RTN","SDHL7CON",89,0) S HIT=0,EXTIME="" "RTN","SDHL7CON",90,0) ; "RTN","SDHL7CON",91,0) ;****BUILD THE RESPONSE MSG "RTN","SDHL7CON",92,0) K @MSGROOT "RTN","SDHL7CON",93,0) ; "RTN","SDHL7CON",94,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7CON",95,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7CON",96,0) ; "RTN","SDHL7CON",97,0) N ERR,LEN S ERR="" "RTN","SDHL7CON",98,0) N FOUNDCN "RTN","SDHL7CON",99,0) S FOUNDCN=0 "RTN","SDHL7CON",100,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",101,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^SDTMBUS(.HL,""),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",102,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.QPD,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",103,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.RDF,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",104,0) I '$P(ERR,"^",4) D "RTN","SDHL7CON",105,0) . Q:DATAROOT="" "RTN","SDHL7CON",106,0) . D @("RDT^SDTMBUS"_"(MSGROOT,DATAROOT,.CNT,.LEN,.HL,.FOUNDCN)") "RTN","SDHL7CON",107,0) . D RTCRDT^SDTMBUS(MSGROOT,RTCLST,.CNT,.LEN,.HL) "RTN","SDHL7CON",108,0) . Q "RTN","SDHL7CON",109,0) ; "RTN","SDHL7CON",110,0) I 'FOUNDCN D Q "RTN","SDHL7CON",111,0) . S ERR="RDT^1^^100^AA^No consults found" "RTN","SDHL7CON",112,0) . D SENDERR(ERR) "RTN","SDHL7CON",113,0) . K @DATAROOT,@MSGROOT "RTN","SDHL7CON",114,0) . Q "RTN","SDHL7CON",115,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7CON",116,0) ; "RTN","SDHL7CON",117,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7CON",118,0) ; "RTN","SDHL7CON",119,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7CON",120,0) ; "RTN","SDHL7CON",121,0) D RESET^SDHL7UL ;Clean up TMP used by logging "RTN","SDHL7CON",122,0) K @DATAROOT,@MSGROOT "RTN","SDHL7CON",123,0) ; "RTN","SDHL7CON",124,0) Q "RTN","SDHL7CON",125,0) ; "RTN","SDHL7CON",126,0) VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message "RTN","SDHL7CON",127,0) ; "RTN","SDHL7CON",128,0) ; Messages handled: QBP^Q13 "RTN","SDHL7CON",129,0) ; "RTN","SDHL7CON",130,0) ; QBP query messages must contain QPD and RCP segments "RTN","SDHL7CON",131,0) ; Any additional segments are ignored "RTN","SDHL7CON",132,0) ; "RTN","SDHL7CON",133,0) ; Input: "RTN","SDHL7CON",134,0) ; MSGROOT - Root of array holding message "RTN","SDHL7CON",135,0) ; XMT - Transmission parameters "RTN","SDHL7CON",136,0) ; "RTN","SDHL7CON",137,0) ; Output: "RTN","SDHL7CON",138,0) ; QRY - Query Array "RTN","SDHL7CON",139,0) ; XMT - Transmission parameters "RTN","SDHL7CON",140,0) ; ERR - segment^sequence^field^code^ACK type^error text "RTN","SDHL7CON",141,0) ; "RTN","SDHL7CON",142,0) N MSH,QPD,REQID,REQTYPE,QTAG,QNAME,RDF "RTN","SDHL7CON",143,0) N SEGTYPE,CNT "RTN","SDHL7CON",144,0) K QRY,ERR "RTN","SDHL7CON",145,0) S ERR="" "RTN","SDHL7CON",146,0) ; "RTN","SDHL7CON",147,0) ; Set up basics for responding to message. "RTN","SDHL7CON",148,0) ;----------------------------------------- "RTN","SDHL7CON",149,0) S QRY("MID")=XMT("MID") ;Message ID "RTN","SDHL7CON",150,0) S QRY("QPD")="" "RTN","SDHL7CON",151,0) ; "RTN","SDHL7CON",152,0) ; Validate message is a well-formed QBP query message. "RTN","SDHL7CON",153,0) ;----------------------------------------------------------- "RTN","SDHL7CON",154,0) ; Must have MSH first, followed by QPD,RCP in any order "RTN","SDHL7CON",155,0) ; PID and STF are optional. All other segments are ignored. "RTN","SDHL7CON",156,0) ; "RTN","SDHL7CON",157,0) I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) "RTN","SDHL7CON",158,0) E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 "RTN","SDHL7CON",159,0) ; "RTN","SDHL7CON",160,0) S CNT=2 "RTN","SDHL7CON",161,0) F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 "RTN","SDHL7CON",162,0) . S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7CON",163,0) . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q "RTN","SDHL7CON",164,0) . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q "RTN","SDHL7CON",165,0) . Q "RTN","SDHL7CON",166,0) ; "RTN","SDHL7CON",167,0) I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0 "RTN","SDHL7CON",168,0) ; "RTN","SDHL7CON",169,0) S QTAG=$G(QPD(1,1,2)) ;Query Tag "RTN","SDHL7CON",170,0) S REQID=$G(QPD(2)) ;Request ID "RTN","SDHL7CON",171,0) S REQTYPE=$G(QPD(3,1,1)) ;Request Type "RTN","SDHL7CON",172,0) S:REQTYPE="" REQTYPE=$G(QPD(3)) ;Request Type if no other params "RTN","SDHL7CON",173,0) ; "RTN","SDHL7CON",174,0) ; Validate required fields and query parameters "RTN","SDHL7CON",175,0) ;------------------------------------------------------ "RTN","SDHL7CON",176,0) ; "RTN","SDHL7CON",177,0) ; Check for missing/invalid fields "RTN","SDHL7CON",178,0) ; "RTN","SDHL7CON",179,0) I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0 "RTN","SDHL7CON",180,0) ; "RTN","SDHL7CON",181,0) I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0 "RTN","SDHL7CON",182,0) I REQID="" S ERR="QPD^1^2^101^AE^Missing Request ID" Q 0 "RTN","SDHL7CON",183,0) S (QRY("DCLSNM"),QRY("DFN"))="" "RTN","SDHL7CON",184,0) S QRY("REQID")=REQID "RTN","SDHL7CON",185,0) ; "RTN","SDHL7CON",186,0) I REQTYPE="" S ERR="QPD^1^3^101^AE^Missing Request Type" Q 0 "RTN","SDHL7CON",187,0) ; "RTN","SDHL7CON",188,0) Q 1 "RTN","SDHL7CON",189,0) ; "RTN","SDHL7CON",190,0) LOADXMT(HL,XMT) ;Set HL dependent XMT values "RTN","SDHL7CON",191,0) ; "RTN","SDHL7CON",192,0) ; The HL array and variables are expected to be defined. If not, "RTN","SDHL7CON",193,0) ; message processing will fail. These references should not be "RTN","SDHL7CON",194,0) ; wrapped in $G, as null values will simply postpone the failure to "RTN","SDHL7CON",195,0) ; a point that will be harder to diagnose. Except HL("APAT") which "RTN","SDHL7CON",196,0) ; is not defined on synchronous calls. "RTN","SDHL7CON",197,0) ; "RTN","SDHL7CON",198,0) ; Integration Agreements: "RTN","SDHL7CON",199,0) ; 1373 : Reference to PROTOCOL file #101 "RTN","SDHL7CON",200,0) ; "RTN","SDHL7CON",201,0) N SUBPROT,RESPIEN,RESP0 "RTN","SDHL7CON",202,0) S HL("EID")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7CON",203,0) S HL("EIDS")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Subscriber") "RTN","SDHL7CON",204,0) S XMT("MID")=HL("MID") ;Message ID "RTN","SDHL7CON",205,0) S XMT("MODE")="A" ;Response mode "RTN","SDHL7CON",206,0) I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode "RTN","SDHL7CON",207,0) S XMT("MESSAGE TYPE")=HL("MTN") ;Message type "RTN","SDHL7CON",208,0) S XMT("EVENT TYPE")=HL("ETN") ;Event type "RTN","SDHL7CON",209,0) S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters "RTN","SDHL7CON",210,0) ;S XMT("DELIM")="~^\&" "RTN","SDHL7CON",211,0) S XMT("MAX SIZE")=0 ;Default size unlimited "RTN","SDHL7CON",212,0) ; "RTN","SDHL7CON",213,0) ; Map response protocol and builder "RTN","SDHL7CON",214,0) S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") "RTN","SDHL7CON",215,0) Q "RTN","SDHL7CON",216,0) LIST(SDY,SDPT,SDSDT,SDEDT,SDSERV,SDSTATUS) ; return patient's consult requests between start date and stop date for the service and status indicated: "RTN","SDHL7CON",217,0) N I,J,SITE,SEQ,DIFF,SDSRV,ORLOC,GMRCOER "RTN","SDHL7CON",218,0) S J=1,SEQ="",GMRCOER=2 "RTN","SDHL7CON",219,0) S:'$L($G(SDSDT)) SDSDT="" "RTN","SDHL7CON",220,0) S:'$L($G(SDEDT)) SDEDT="" "RTN","SDHL7CON",221,0) S:'$L($G(SDSERV))!(+$G(SDSERV)=0) SDSERV="" "RTN","SDHL7CON",222,0) S:'$L($G(SDSTATUS)) SDSTATUS="" ;ALL STATI "RTN","SDHL7CON",223,0) K ^TMP("GMRCR",$J) "RTN","SDHL7CON",224,0) S SDY=$NA(^TMP("ORQQCN",$J,"CS")) "RTN","SDHL7CON",225,0) D OER^GMRCSLM1(SDPT,SDSERV,SDSDT,SDEDT,SDSTATUS,GMRCOER) "RTN","SDHL7CON",226,0) M @SDY=^TMP("GMRCR",$J,"CS") "RTN","SDHL7CON",227,0) K @SDY@("AD") "RTN","SDHL7CON",228,0) K @SDY@(0) "RTN","SDHL7CON",229,0) K ^TMP("GMRCR",$J) "RTN","SDHL7CON",230,0) Q "RTN","SDHL7CON",231,0) RTCLIST(SDY,SDPT,SDSDT,SDEDT) ; return patient's "Return to Clinic" appointment requests "RTN","SDHL7CON",232,0) ;SDY = return global "RTN","SDHL7CON",233,0) ;SDPT = dfn of patient "RTN","SDHL7CON",234,0) ;SDSDT = start date (based on CREATE DATE of request) "RTN","SDHL7CON",235,0) ;SDEDT = end date (based on END DATE of request) "RTN","SDHL7CON",236,0) N IDX,IEN,SDEC0,REQDT,CNT,CLINID,CID,STOP,PRVID,CMTS,MRTC,RTCINT,RTCINT,RTCPAR "RTN","SDHL7CON",237,0) S SDY=$NA(^TMP("SDHL7CON",$J,"RTCLIST")) K @SDY "RTN","SDHL7CON",238,0) S SDSDT=$G(SDSDT,"ALL"),SDEDT=$G(SDEDT),CNT=0 "RTN","SDHL7CON",239,0) Q:'$G(SDPT) ; Return nothing if no patient passed "RTN","SDHL7CON",240,0) S IDX=$NA(^SDEC(409.85,"B",SDPT)),IEN=0 "RTN","SDHL7CON",241,0) F S IEN=$O(@IDX@(IEN)) Q:'$G(IEN) D "RTN","SDHL7CON",242,0) . K RTCINT,MRTC,RTCPAR,SDEC0,CLINID,CID,PRVID,CMTS,CLINNM,STOP "RTN","SDHL7CON",243,0) . S SDEC0=$G(^SDEC(409.85,IEN,0)) "RTN","SDHL7CON",244,0) . I $P(SDEC0,U,5)'="RTC" Q "RTN","SDHL7CON",245,0) . I $P(SDEC0,U,17)'="O" Q "RTN","SDHL7CON",246,0) . S REQDT=$P(SDEC0,U,2) I SDSDT'="ALL",$P(REQDT,".",1)SDEDT) Q "RTN","SDHL7CON",247,0) . S CLINID=$P(SDEC0,U,9),CID=$P(SDEC0,U,16),PRVID=$P(SDEC0,U,13),CMTS=$P(SDEC0,U,18),CMTS=$E(CMTS,1,80) "RTN","SDHL7CON",248,0) . S:$P($G(^SDEC(409.85,IEN,3)),"^")=1 MRTC=$P($G(^SDEC(409.85,IEN,3)),"^",3),RTCINT=$P($G(^SDEC(409.85,IEN,3)),"^",2),RTCPAR=$P($G(^SDEC(409.85,IEN,3)),"^",5) "RTN","SDHL7CON",249,0) . S:$G(RTCPAR)="" RTCPAR=IEN "RTN","SDHL7CON",250,0) . S:$G(MRTC)="" MRTC=0 S:$G(RTCINT)="" RTCINT=0 "RTN","SDHL7CON",251,0) . I +CLINID D "RTN","SDHL7CON",252,0) . . S CLINNM=$$GET1^DIQ(44,CLINID_",",".01") "RTN","SDHL7CON",253,0) . . S STOP=$$GET1^DIQ(44,CLINID_",",8)_","_$$GET1^DIQ(44,CLINID_",",2503) "RTN","SDHL7CON",254,0) . S CNT=CNT+1,@SDY@(CNT)=IEN_U_REQDT_U_CLINID_U_CID_U_PRVID_U_CMTS_U_$G(MRTC)_U_$G(RTCINT)_U_$G(RTCPAR) "RTN","SDHL7CON",255,0) S @SDY=CNT "RTN","SDHL7CON",256,0) Q "RTN","SDHL7CON",257,0) TMCONV(X) ; "RTN","SDHL7CON",258,0) ;convert time to Zulu timezone "RTN","SDHL7CON",259,0) N TZONE,DIFF,UTC,UTC1,UTC2 "RTN","SDHL7CON",260,0) S TZONE=$$GET1^DIQ(4.3,"1,",1,"I"),DIFF=$$GET1^DIQ(4.4,$G(TZONE)_",",2,"E")*(-1) "RTN","SDHL7CON",261,0) S UTC=$$FMADD^XLFDT(X,,$G(DIFF),,),UTC2=$$FMTHL7^XLFDT(UTC) "RTN","SDHL7CON",262,0) S UTC1=$E(UTC2,1,4)_"-"_$E(UTC2,5,6)_"-"_$E(UTC2,7,8)_"T"_$E(UTC2,9,10)_":"_$E(UTC2,11,12)_":00.000Z" "RTN","SDHL7CON",263,0) Q UTC1 "RTN","SDHL7CON",264,0) PARSESEG(SEG,DATA,HL) ;Generic segment parser "RTN","SDHL7CON",265,0) ;This procedure parses a single HL7 segment and builds an array "RTN","SDHL7CON",266,0) ;subscripted by the field number containing the data for that field. "RTN","SDHL7CON",267,0) ; Does not handle segments that span nodes "RTN","SDHL7CON",268,0) ; "RTN","SDHL7CON",269,0) ; Input: "RTN","SDHL7CON",270,0) ; SEG - HL7 segment to parse "RTN","SDHL7CON",271,0) ; HL - HL7 environment array "RTN","SDHL7CON",272,0) ; "RTN","SDHL7CON",273,0) ; Output: "RTN","SDHL7CON",274,0) ; Function value - field data array [SUB1:field, SUB2:repetition, "RTN","SDHL7CON",275,0) ; SUB3:component, SUB4:sub-component] "RTN","SDHL7CON",276,0) ; "RTN","SDHL7CON",277,0) N CMP ;component subscript "RTN","SDHL7CON",278,0) N CMPVAL ;component value "RTN","SDHL7CON",279,0) N FLD ;field subscript "RTN","SDHL7CON",280,0) N FLDVAL ;field value "RTN","SDHL7CON",281,0) N REP ;repetition subscript "RTN","SDHL7CON",282,0) N REPVAL ;repetition value "RTN","SDHL7CON",283,0) N SUB ;sub-component subscript "RTN","SDHL7CON",284,0) N SUBVAL ;sub-component value "RTN","SDHL7CON",285,0) N FS ;field separator "RTN","SDHL7CON",286,0) N CS ;component separator "RTN","SDHL7CON",287,0) N RS ;repetition separator "RTN","SDHL7CON",288,0) N SS ;sub-component separator "RTN","SDHL7CON",289,0) ; "RTN","SDHL7CON",290,0) K DATA "RTN","SDHL7CON",291,0) S FS=HL("FS") "RTN","SDHL7CON",292,0) S CS=$E(HL("ECH")) "RTN","SDHL7CON",293,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7CON",294,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7CON",295,0) ; "RTN","SDHL7CON",296,0) S DATA(0)=$P(SEG,FS) "RTN","SDHL7CON",297,0) S SEG=$P(SEG,FS,2,9999) "RTN","SDHL7CON",298,0) ; "RTN","SDHL7CON",299,0) F FLD=1:1:$L(SEG,FS) D "RTN","SDHL7CON",300,0) . S FLDVAL=$P(SEG,FS,FLD) "RTN","SDHL7CON",301,0) . F REP=1:1:$L(FLDVAL,RS) D "RTN","SDHL7CON",302,0) . . S REPVAL=$P(FLDVAL,RS,REP) "RTN","SDHL7CON",303,0) . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D "RTN","SDHL7CON",304,0) . . . S CMPVAL=$P(REPVAL,CS,CMP) "RTN","SDHL7CON",305,0) . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D "RTN","SDHL7CON",306,0) . . . . S SUBVAL=$P(CMPVAL,SS,SUB) "RTN","SDHL7CON",307,0) . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL "RTN","SDHL7CON",308,0) . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL "RTN","SDHL7CON",309,0) . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL "RTN","SDHL7CON",310,0) . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL "RTN","SDHL7CON",311,0) Q "RTN","SDHL7CON",312,0) ; "RTN","SDHL7CON",313,0) LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing "RTN","SDHL7CON",314,0) ; "RTN","SDHL7CON",315,0) ;This subroutine assumes that all VistA HL7 environment variables are "RTN","SDHL7CON",316,0) ;properly initialized and will produce a fatal error if they aren't. "RTN","SDHL7CON",317,0) ; "RTN","SDHL7CON",318,0) N CNT,SEG "RTN","SDHL7CON",319,0) K @MSGROOT "RTN","SDHL7CON",320,0) F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7CON",321,0) . S CNT=0 "RTN","SDHL7CON",322,0) . S @MSGROOT@(SEG,CNT)=HLNODE "RTN","SDHL7CON",323,0) . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) "RTN","SDHL7CON",324,0) Q "RTN","SDHL7CON",325,0) ; "RTN","SDHL7CON",326,0) PARSEMSG(MSGROOT,HL) ; Message Parser "RTN","SDHL7CON",327,0) ; Does not handle segments that span nodes "RTN","SDHL7CON",328,0) ; Does not handle extremely long segments (uses a local) "RTN","SDHL7CON",329,0) ; Does not handle long fields (segment parser doesn't) "RTN","SDHL7CON",330,0) ; "RTN","SDHL7CON",331,0) N SEG,CNT,DATA,MSG "RTN","SDHL7CON",332,0) F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D "RTN","SDHL7CON",333,0) . D PARSESEG(SEG(0),.DATA,.HL) "RTN","SDHL7CON",334,0) . K @MSGROOT@(CNT) "RTN","SDHL7CON",335,0) . I DATA(0)'="" M @MSGROOT@(CNT)=DATA "RTN","SDHL7CON",336,0) . Q:'$D(SEG(1)) "RTN","SDHL7CON",337,0) . ; "RTN","SDHL7CON",338,0) . Q "RTN","SDHL7CON",339,0) Q "RTN","SDHL7CON",340,0) SENDERR(ERR) ; Send for unsuccessful response "RTN","SDHL7CON",341,0) K @MSGROOT "RTN","SDHL7CON",342,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7CON",343,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7CON",344,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",345,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^SDTMBUS(.HL,ERR),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",346,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7CON",347,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7CON",348,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7CON",349,0) Q "RTN","SDHL7UL") 0^6^B60504057^n/a "RTN","SDHL7UL",1,0) SDHL7UL ;MS/TG - TMP HL7 Routine;JULY 23, 2018 "RTN","SDHL7UL",2,0) ;;5.3;Scheduling;**704**;May 29, 2018;Build 64 "RTN","SDHL7UL",3,0) ; "RTN","SDHL7UL",4,0) Q ;Direct entry not supported "RTN","SDHL7UL",5,0) ; "RTN","SDHL7UL",6,0) LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing "RTN","SDHL7UL",7,0) ; "RTN","SDHL7UL",8,0) ;This subroutine assumes that all VistA HL7 environment variables are "RTN","SDHL7UL",9,0) ;properly initialized and will produce a fatal error if they aren't. "RTN","SDHL7UL",10,0) ; "RTN","SDHL7UL",11,0) N CNT,SEG "RTN","SDHL7UL",12,0) K @MSGROOT "RTN","SDHL7UL",13,0) F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7UL",14,0) . S CNT=0 "RTN","SDHL7UL",15,0) . S @MSGROOT@(SEG,CNT)=HLNODE "RTN","SDHL7UL",16,0) . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) "RTN","SDHL7UL",17,0) Q "RTN","SDHL7UL",18,0) ; "RTN","SDHL7UL",19,0) LOADXMT(XMT) ;Set HL dependent XMT values "RTN","SDHL7UL",20,0) ; "RTN","SDHL7UL",21,0) ; The HL array and variables are expected to be defined. If not, "RTN","SDHL7UL",22,0) ; message processing will fail. These references should not be "RTN","SDHL7UL",23,0) ; wrapped in $G, as null values will simply postpone the failure to "RTN","SDHL7UL",24,0) ; a point that will be harder to diagnose. Except HL("APAT") which "RTN","SDHL7UL",25,0) ; is not defined on synchronous calls. "RTN","SDHL7UL",26,0) ; "RTN","SDHL7UL",27,0) N SUBPROT,RESPIEN,RESP0 "RTN","SDHL7UL",28,0) S XMT("MID")=HL("MID") ;Message ID "RTN","SDHL7UL",29,0) S XMT("MODE")="A" ;Response mode "RTN","SDHL7UL",30,0) I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode "RTN","SDHL7UL",31,0) S XMT("HLMTIENS")=HLMTIENS ;Message IEN "RTN","SDHL7UL",32,0) S XMT("MESSAGE TYPE")=HL("MTN") ;Message type "RTN","SDHL7UL",33,0) S XMT("EVENT TYPE")=HL("ETN") ;Event type "RTN","SDHL7UL",34,0) S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters "RTN","SDHL7UL",35,0) S XMT("MAX SIZE")=0 ;Default size unlimited "RTN","SDHL7UL",36,0) ; "RTN","SDHL7UL",37,0) ; Map response protocol and builder "RTN","SDHL7UL",38,0) S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") "RTN","SDHL7UL",39,0) Q "RTN","SDHL7UL",40,0) ; "RTN","SDHL7UL",41,0) DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol "RTN","SDHL7UL",42,0) ; "RTN","SDHL7UL",43,0) ; Integration Agreements: "RTN","SDHL7UL",44,0) ; 2161 : INIT^HLFNC2 "RTN","SDHL7UL",45,0) ; "RTN","SDHL7UL",46,0) N HL "RTN","SDHL7UL",47,0) Q:PROTOCOL="" "" "RTN","SDHL7UL",48,0) D INIT^HLFNC2(PROTOCOL,.HL) "RTN","SDHL7UL",49,0) Q $G(HL("FS"))_$G(HL("ECH")) "RTN","SDHL7UL",50,0) ; "RTN","SDHL7UL",51,0) PARSEMSG(MSGROOT,HL) ; Message Parser "RTN","SDHL7UL",52,0) ; Does not handle segments that span nodes "RTN","SDHL7UL",53,0) ; Does not handle extremely long segments (uses a local) "RTN","SDHL7UL",54,0) ; Does not handle long fields (segment parser doesn't) "RTN","SDHL7UL",55,0) ; "RTN","SDHL7UL",56,0) N SEG,CNT,DATA,MSG "RTN","SDHL7UL",57,0) F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D "RTN","SDHL7UL",58,0) . D PARSESEG(SEG(0),.DATA,.HL) "RTN","SDHL7UL",59,0) . K @MSGROOT@(CNT) "RTN","SDHL7UL",60,0) . I DATA(0)'="" M @MSGROOT@(CNT)=DATA "RTN","SDHL7UL",61,0) . Q:'$D(SEG(1)) "RTN","SDHL7UL",62,0) . ;Add handler for segments that span nodes here. "RTN","SDHL7UL",63,0) . Q "RTN","SDHL7UL",64,0) Q "RTN","SDHL7UL",65,0) ; "RTN","SDHL7UL",66,0) PARSESEG(SEG,DATA,HL) ;Generic segment parser "RTN","SDHL7UL",67,0) ;This procedure parses a single HL7 segment and builds an array "RTN","SDHL7UL",68,0) ;subscripted by the field number containing the data for that field. "RTN","SDHL7UL",69,0) ; Does not handle segments that span nodes "RTN","SDHL7UL",70,0) ; "RTN","SDHL7UL",71,0) ; Input: "RTN","SDHL7UL",72,0) ; SEG - HL7 segment to parse "RTN","SDHL7UL",73,0) ; HL - HL7 environment array "RTN","SDHL7UL",74,0) ; "RTN","SDHL7UL",75,0) ; Output: "RTN","SDHL7UL",76,0) ; Function value - field data array [SUB1:field, SUB2:repetition, "RTN","SDHL7UL",77,0) ; SUB3:component, SUB4:sub-component] "RTN","SDHL7UL",78,0) ; "RTN","SDHL7UL",79,0) N CMP ;component subscript "RTN","SDHL7UL",80,0) N CMPVAL ;component value "RTN","SDHL7UL",81,0) N FLD ;field subscript "RTN","SDHL7UL",82,0) N FLDVAL ;field value "RTN","SDHL7UL",83,0) N REP ;repetition subscript "RTN","SDHL7UL",84,0) N REPVAL ;repetition value "RTN","SDHL7UL",85,0) N SUB ;sub-component subscript "RTN","SDHL7UL",86,0) N SUBVAL ;sub-component value "RTN","SDHL7UL",87,0) N FS ;field separator "RTN","SDHL7UL",88,0) N CS ;component separator "RTN","SDHL7UL",89,0) N RS ;repetition separator "RTN","SDHL7UL",90,0) N SS ;sub-component separator "RTN","SDHL7UL",91,0) ; "RTN","SDHL7UL",92,0) K DATA "RTN","SDHL7UL",93,0) S FS=HL("FS") "RTN","SDHL7UL",94,0) S CS=$E(HL("ECH")) "RTN","SDHL7UL",95,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7UL",96,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7UL",97,0) ; "RTN","SDHL7UL",98,0) S DATA(0)=$P(SEG,FS) "RTN","SDHL7UL",99,0) S SEG=$P(SEG,FS,2,9999) "RTN","SDHL7UL",100,0) F FLD=1:1:$L(SEG,FS) D "RTN","SDHL7UL",101,0) . S FLDVAL=$P(SEG,FS,FLD) "RTN","SDHL7UL",102,0) . F REP=1:1:$L(FLDVAL,RS) D "RTN","SDHL7UL",103,0) . . S REPVAL=$P(FLDVAL,RS,REP) "RTN","SDHL7UL",104,0) . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D "RTN","SDHL7UL",105,0) . . . S CMPVAL=$P(REPVAL,CS,CMP) "RTN","SDHL7UL",106,0) . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D "RTN","SDHL7UL",107,0) . . . . S SUBVAL=$P(CMPVAL,SS,SUB) "RTN","SDHL7UL",108,0) . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL "RTN","SDHL7UL",109,0) . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL "RTN","SDHL7UL",110,0) . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL "RTN","SDHL7UL",111,0) . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL "RTN","SDHL7UL",112,0) Q "RTN","SDHL7UL",113,0) ; "RTN","SDHL7UL",114,0) BLDSEG(DATA,HL) ;generic segment builder "RTN","SDHL7UL",115,0) ; "RTN","SDHL7UL",116,0) ; Input: "RTN","SDHL7UL",117,0) ; DATA - field data array [SUB1:field, SUB2:repetition, "RTN","SDHL7UL",118,0) ; SUB3:component, SUB4:sub-component] "RTN","SDHL7UL",119,0) ; HL - HL7 environment array "RTN","SDHL7UL",120,0) ; "RTN","SDHL7UL",121,0) ; Output: "RTN","SDHL7UL",122,0) ; Function Value - Formatted HL7 segment on success, "" on failure "RTN","SDHL7UL",123,0) ; "RTN","SDHL7UL",124,0) N CMP ;component subscript "RTN","SDHL7UL",125,0) N CMPVAL ;component value "RTN","SDHL7UL",126,0) N FLD ;field subscript "RTN","SDHL7UL",127,0) N FLDVAL ;field value "RTN","SDHL7UL",128,0) N REP ;repetition subscript "RTN","SDHL7UL",129,0) N REPVAL ;repetition value "RTN","SDHL7UL",130,0) N SUB ;sub-component subscript "RTN","SDHL7UL",131,0) N SUBVAL ;sub-component value "RTN","SDHL7UL",132,0) N FS ;field separator "RTN","SDHL7UL",133,0) N CS ;component separator "RTN","SDHL7UL",134,0) N RS ;repetition separator "RTN","SDHL7UL",135,0) N ES ;escape character "RTN","SDHL7UL",136,0) N SS ;sub-component separator "RTN","SDHL7UL",137,0) N SEG,SEP "RTN","SDHL7UL",138,0) ; "RTN","SDHL7UL",139,0) S FS=HL("FS") "RTN","SDHL7UL",140,0) S CS=$E(HL("ECH")) "RTN","SDHL7UL",141,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7UL",142,0) S ES=$E(HL("ECH"),3) "RTN","SDHL7UL",143,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7UL",144,0) ; "RTN","SDHL7UL",145,0) S SEG=$G(DATA(0)) "RTN","SDHL7UL",146,0) F FLD=1:1:$O(DATA(""),-1) D "RTN","SDHL7UL",147,0) . S FLDVAL=$G(DATA(FLD)),SEP=FS "RTN","SDHL7UL",148,0) . S SEG=SEG_SEP_FLDVAL "RTN","SDHL7UL",149,0) . F REP=1:1:$O(DATA(FLD,""),-1) D "RTN","SDHL7UL",150,0) . . S REPVAL=$G(DATA(FLD,REP)) "RTN","SDHL7UL",151,0) . . S SEP=$S(REP=1:"",1:RS) "RTN","SDHL7UL",152,0) . . S SEG=SEG_SEP_REPVAL "RTN","SDHL7UL",153,0) . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D "RTN","SDHL7UL",154,0) . . . S CMPVAL=$G(DATA(FLD,REP,CMP)) "RTN","SDHL7UL",155,0) . . . S SEP=$S(CMP=1:"",1:CS) "RTN","SDHL7UL",156,0) . . . S SEG=SEG_SEP_CMPVAL "RTN","SDHL7UL",157,0) . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D "RTN","SDHL7UL",158,0) . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB)) "RTN","SDHL7UL",159,0) . . . . S SEP=$S(SUB=1:"",1:SS) "RTN","SDHL7UL",160,0) . . . . S SEG=SEG_SEP_SUBVAL "RTN","SDHL7UL",161,0) Q SEG "RTN","SDHL7UL",162,0) ; "RTN","SDHL7UL",163,0) RESET ; Initialize or clear session pointer into log "RTN","SDHL7UL",164,0) K ^TMP("SDHL7LOG",$J) "RTN","SDHL7UL",165,0) Q "RTN","SDHL7UL",166,0) LOGPRG(RESULT,DTM) ;Purge SDHL7 application log "RTN","SDHL7UL",167,0) ; "RTN","SDHL7UL",168,0) ; Input: "RTN","SDHL7UL",169,0) ; DTM - Purge Date/Time - optional "RTN","SDHL7UL",170,0) ; Fileman date/time "RTN","SDHL7UL",171,0) ; Default to older than a week "RTN","SDHL7UL",172,0) ; "RTN","SDHL7UL",173,0) ; Output: "RTN","SDHL7UL",174,0) ; RESULT - success flag ^ purge date/time "RTN","SDHL7UL",175,0) ; "RTN","SDHL7UL",176,0) N %DT,X,Y "RTN","SDHL7UL",177,0) S X=$G(DTM),%DT="TX" D ^%DT S DTM=Y "RTN","SDHL7UL",178,0) I DTM<0 S DTM=$$HTFM^XLFDT($H-7,1) "RTN","SDHL7UL",179,0) S RESULT=DTM "RTN","SDHL7UL",180,0) S DTM=-DTM "RTN","SDHL7UL",181,0) F S DTM=$O(^XTMP("SDHL7LOG",2,DTM)) Q:DTM="" K ^XTMP("SDHL7LOG",2,DTM) "RTN","SDHL7UL",182,0) S RESULT="1^"_RESULT "RTN","SDHL7UL",183,0) Q "RTN","SDHL7UL",184,0) ; "RTN","SDHL7UL",185,0) AUTOPRG ; "RTN","SDHL7UL",186,0) Q:'$G(^XTMP("SDHL7LOG",1,"AUTOPURGE")) "RTN","SDHL7UL",187,0) N DT,DAYS,RESULT "RTN","SDHL7UL",188,0) ; Purge only once per day "RTN","SDHL7UL",189,0) S DT=$$DT^XLFDT "RTN","SDHL7UL",190,0) Q:$G(^XTMP("SDHL7LOG",1,"AUTOPURGE","PURGE DATE"))=DT "RTN","SDHL7UL",191,0) ; "RTN","SDHL7UL",192,0) S DAYS=$G(^XTMP("SDHL7LOG",1,"AUTOPURGE","DAYS")) "RTN","SDHL7UL",193,0) I DAYS<1 S DAYS=7 "RTN","SDHL7UL",194,0) ; "RTN","SDHL7UL",195,0) D LOGPRG(.RESULT,$$HTFM^XLFDT($H-DAYS,1)) "RTN","SDHL7UL",196,0) S ^XTMP("SDHL7LOG",1,"AUTOPURGE","PURGE DATE")=DT "RTN","SDHL7UL",197,0) Q "RTN","SDHL7UL",198,0) ; "RTN","SDHL7UL",199,0) LOG(NAME,DATA,TYPE,LEVEL) ;Log to SDHL7 application log "RTN","SDHL7UL",200,0) ; "RTN","SDHL7UL",201,0) ; Input: "RTN","SDHL7UL",202,0) ; NAME - Name to identify log entry "RTN","SDHL7UL",203,0) ; DATA - Value,Tree, or Name of structure to put in log "RTN","SDHL7UL",204,0) ; TYPE - Type of log entry "RTN","SDHL7UL",205,0) ; S:Set Single Value "RTN","SDHL7UL",206,0) ; M:Merge Tree "RTN","SDHL7UL",207,0) ; I:Indirect Merge @ "RTN","SDHL7UL",208,0) ; LEVEL - Level of log entry - ERROR,TRACE,NAMED,DEBUG "RTN","SDHL7UL",209,0) ; "RTN","SDHL7UL",210,0) ; Output: "RTN","SDHL7UL",211,0) ; Adds entry to log "RTN","SDHL7UL",212,0) ; "RTN","SDHL7UL",213,0) ; ^XTMP("SDHL7LOG",0) - Head of log file "RTN","SDHL7UL",214,0) ; ^XTMP("SDHL7LOG",1) - if set indicates that logging is on "RTN","SDHL7UL",215,0) ; ^XTMP("SDHL7LOG",1,"LEVEL") - logging level "RTN","SDHL7UL",216,0) ; ^XTMP("SDHL7LOG",1,"LEVEL",LEVEL) = rank "RTN","SDHL7UL",217,0) ; ^XTMP("SDHL7LOG",1,"NAMES",) - names to log caret delimited string "RTN","SDHL7UL",218,0) ; ^XTMP("SDHL7LOG",1,"NAMES",NAME) - name to log "RTN","SDHL7UL",219,0) ; ^XTMP("SDHL7LOG",2) - contains the log "RTN","SDHL7UL",220,0) ; ^XTMP("SDHL7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry "RTN","SDHL7UL",221,0) ; "RTN","SDHL7UL",222,0) ; ^TMP("SDHL7LOG",$J) - Session current log entry (DTM) "RTN","SDHL7UL",223,0) ; "RTN","SDHL7UL",224,0) ;Quit if logging is not turned on "RTN","SDHL7UL",225,0) Q:'$G(^XTMP("SDHL7LOG",1)) "RTN","SDHL7UL",226,0) N DTM,CNT,LOGLEVEL "RTN","SDHL7UL",227,0) ; "RTN","SDHL7UL",228,0) Q:'$D(DATA) "RTN","SDHL7UL",229,0) Q:$G(TYPE)="" "RTN","SDHL7UL",230,0) Q:$G(NAME)="" "RTN","SDHL7UL",231,0) S NAME=$TR(NAME,"^","-") "RTN","SDHL7UL",232,0) ; "RTN","SDHL7UL",233,0) ;If LEVEL is null or unknown default to DEBUG "RTN","SDHL7UL",234,0) I $G(LEVEL)="" S LEVEL="DEBUG" "RTN","SDHL7UL",235,0) I '$D(^XTMP("SDHL7LOG",1,"LEVEL",LEVEL)) S LEVEL="DEBUG" "RTN","SDHL7UL",236,0) ; "RTN","SDHL7UL",237,0) ;Log entries at or lower than the current logging level set "RTN","SDHL7UL",238,0) ;Levels are ranked as follows: "RTN","SDHL7UL",239,0) ; ^XTMP("SDHL7LOG",1,"LEVEL","ERROR")=1 "RTN","SDHL7UL",240,0) ; ^XTMP("SDHL7LOG",1,"LEVEL","TRACE")=2 "RTN","SDHL7UL",241,0) ; ^XTMP("SDHL7LOG",1,"LEVEL","NAMED")=3 "RTN","SDHL7UL",242,0) ; ^XTMP("SDHL7LOG",1,"LEVEL","DEBUG")=4 "RTN","SDHL7UL",243,0) ;Named is like a filtered version of debug. "RTN","SDHL7UL",244,0) ;Additional levels may be added, and ranks changed without affecting "RTN","SDHL7UL",245,0) ;the LOG api. Inserting a level between Named and Debug will require "RTN","SDHL7UL",246,0) ;a change to the conditional below. "RTN","SDHL7UL",247,0) S LOGLEVEL=$G(^XTMP("SDHL7LOG",1,"LEVEL")) "RTN","SDHL7UL",248,0) I LOGLEVEL="" S LOGLEVEL="TRACE" "RTN","SDHL7UL",249,0) I $G(^XTMP("SDHL7LOG",1,"LEVEL",LEVEL))>$G(^XTMP("SDHL7LOG",1,"LEVEL",LOGLEVEL)) Q:LOGLEVEL'="NAMED" Q:'$D(^XTMP("SDHL7LOG",1,"NAMES",NAME)) "RTN","SDHL7UL",250,0) ; "RTN","SDHL7UL",251,0) ; Check ^TMP("SDHL7LOG",$J) If no current log node start a new node "RTN","SDHL7UL",252,0) I '$G(^TMP("SDHL7LOG",$J)) D "RTN","SDHL7UL",253,0) . S DTM=-$$NOW^XLFDT() "RTN","SDHL7UL",254,0) . K ^XTMP("SDHL7LOG",2,DTM,$J) "RTN","SDHL7UL",255,0) . S ^TMP("SDHL7LOG",$J)=DTM "RTN","SDHL7UL",256,0) . S CNT=1 "RTN","SDHL7UL",257,0) . S ^XTMP("SDHL7LOG",2,DTM,$J)=CNT "RTN","SDHL7UL",258,0) . D AUTOPRG "RTN","SDHL7UL",259,0) . Q "RTN","SDHL7UL",260,0) E D "RTN","SDHL7UL",261,0) . S DTM=^TMP("SDHL7LOG",$J) "RTN","SDHL7UL",262,0) . S CNT=$G(^XTMP("SDHL7LOG",2,DTM,$J))+1 "RTN","SDHL7UL",263,0) . S ^XTMP("SDHL7LOG",2,DTM,$J)=CNT "RTN","SDHL7UL",264,0) . Q "RTN","SDHL7UL",265,0) ; "RTN","SDHL7UL",266,0) I TYPE="S" S ^XTMP("SDHL7LOG",2,DTM,$J,CNT,NAME)=DATA Q "RTN","SDHL7UL",267,0) I TYPE="M" M ^XTMP("SDHL7LOG",2,DTM,$J,CNT,NAME)=DATA Q "RTN","SDHL7UL",268,0) I TYPE="I" M ^XTMP("SDHL7LOG",2,DTM,$J,CNT,NAME)=@DATA Q "RTN","SDHL7UL",269,0) ; "RTN","SDHL7UL",270,0) Q "RTN","SDHL7UL",271,0) ESCAPE(VAL,HL) ;Escape any special characters "RTN","SDHL7UL",272,0) ; *** Does not handle long strings of special characters *** "RTN","SDHL7UL",273,0) ; "RTN","SDHL7UL",274,0) ; Input: "RTN","SDHL7UL",275,0) ; VAL - value to escape "RTN","SDHL7UL",276,0) ; HL - HL7 environment array "RTN","SDHL7UL",277,0) ; "RTN","SDHL7UL",278,0) ; Output: "RTN","SDHL7UL",279,0) ; VAL - passed by reference "RTN","SDHL7UL",280,0) ; "RTN","SDHL7UL",281,0) N FS ;field separator "RTN","SDHL7UL",282,0) N CS ;component separator "RTN","SDHL7UL",283,0) N RS ;repetition separator "RTN","SDHL7UL",284,0) N ES ;escape character "RTN","SDHL7UL",285,0) N SS ;sub-component separator "RTN","SDHL7UL",286,0) N L,STR,I "RTN","SDHL7UL",287,0) ; "RTN","SDHL7UL",288,0) S FS=HL("FS") "RTN","SDHL7UL",289,0) S CS=$E(HL("ECH")) "RTN","SDHL7UL",290,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7UL",291,0) S ES=$E(HL("ECH"),3) "RTN","SDHL7UL",292,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7UL",293,0) ; "RTN","SDHL7UL",294,0) I VAL[ES D "RTN","SDHL7UL",295,0) . S L=$L(VAL,ES),STR="" "RTN","SDHL7UL",296,0) . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I) "RTN","SDHL7UL",297,0) . S VAL=STR "RTN","SDHL7UL",298,0) I VAL[FS D "RTN","SDHL7UL",299,0) . S L=$L(VAL,FS),STR="" "RTN","SDHL7UL",300,0) . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I) "RTN","SDHL7UL",301,0) . S VAL=STR "RTN","SDHL7UL",302,0) I VAL[RS D "RTN","SDHL7UL",303,0) . S L=$L(VAL,RS),STR="" "RTN","SDHL7UL",304,0) . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I) "RTN","SDHL7UL",305,0) . S VAL=STR "RTN","SDHL7UL",306,0) I VAL[CS D "RTN","SDHL7UL",307,0) . S L=$L(VAL,CS),STR="" "RTN","SDHL7UL",308,0) . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I) "RTN","SDHL7UL",309,0) . S VAL=STR "RTN","SDHL7UL",310,0) I VAL[SS D "RTN","SDHL7UL",311,0) . S L=$L(VAL,SS),STR="" "RTN","SDHL7UL",312,0) . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I) "RTN","SDHL7UL",313,0) . S VAL=STR "RTN","SDHL7UL",314,0) Q VAL "RTN","SDHL7UL",315,0) ; "RTN","SDHLAPT1") 0^16^B192619176^n/a "RTN","SDHLAPT1",1,0) SDHLAPT1 ;MS/PB - VISTA SCHEDULING RPCS ;Nov 14, 2014 "RTN","SDHLAPT1",2,0) ;;5.3;Scheduling;**704**;Nov 14, 2018;Build 64 "RTN","SDHLAPT1",3,0) ; "RTN","SDHLAPT1",4,0) Q "RTN","SDHLAPT1",5,0) ; "RTN","SDHLAPT1",6,0) ARSET(RET,INP) ;Appointment Request Set "RTN","SDHLAPT1",7,0) ;ARSET(RET,INP...) external parameter tag in SDEC "RTN","SDHLAPT1",8,0) ; INP(1) = (integer) Wait List IEN point to "RTN","SDHLAPT1",9,0) ; SDEC APPT REQUEST file 409.85. "RTN","SDHLAPT1",10,0) ; If null, a new entry will be added "RTN","SDHLAPT1",11,0) ; INP(2) = (text) DFN Pointer to the PATIENT file 2 "RTN","SDHLAPT1",12,0) ; INP(3) = (date) Originating Date/time in external date form "RTN","SDHLAPT1",13,0) ; INP(4) = (text) Institution name NAME field from the INSTITUTION file "RTN","SDHLAPT1",14,0) ; INP(5) = (text) Request Type "RTN","SDHLAPT1",15,0) ; INP(6) = (text) REQ Specific Clinic name - NAME field in file 44 "RTN","SDHLAPT1",16,0) ; INP(7) = (text) Originating User name - NAME field in NEW PERSON file 200 "RTN","SDHLAPT1",17,0) ; INP(8) = (text) Priority - 'ASAP' or 'FUTURE' "RTN","SDHLAPT1",18,0) ; INP(9) = (text) Request By - 'PROVIDER' or 'PATIENT' "RTN","SDHLAPT1",19,0) ; INP(10) = (text) Provider name - NAME field in NEW PERSON file200 "RTN","SDHLAPT1",20,0) ; INP(11) = (date) Desired Date of appointment in external format. "RTN","SDHLAPT1",21,0) ; INP(12) = (text) comment must be 1-60 characters "RTN","SDHLAPT1",22,0) ; INP(13) = (text) ENROLLMENT PRIORITY - Valid Values are: "RTN","SDHLAPT1",23,0) ; GROUP 1 "RTN","SDHLAPT1",24,0) ; GROUP 2 "RTN","SDHLAPT1",25,0) ; GROUP 3 "RTN","SDHLAPT1",26,0) ; GROUP 4 "RTN","SDHLAPT1",27,0) ; GROUP 5 "RTN","SDHLAPT1",28,0) ; GROUP 6 "RTN","SDHLAPT1",29,0) ; GROUP 7 "RTN","SDHLAPT1",30,0) ; GROUP 8 "RTN","SDHLAPT1",31,0) ; INP(14) = (text) MULTIPLE APPOINTMENT RTC NO; YES "RTN","SDHLAPT1",32,0) ; INP(15) = (integer) MULT APPT RTC INTERVAL integer between 1-365 "RTN","SDHLAPT1",33,0) ; INP(16) = (integer) MULT APPT NUMBER integer between 1-100 "RTN","SDHLAPT1",34,0) ; INP(17) = Patient Contacts separated by :: "RTN","SDHLAPT1",35,0) ; Each :: piece has the following ~~ pieces: "RTN","SDHLAPT1",36,0) ; 1) = (date) DATE ENTERED external date/time "RTN","SDHLAPT1",37,0) ; 2) = (text) PC ENTERED BY USER ID or NAME - Pointer toNEW PERSON file or NAME "RTN","SDHLAPT1",38,0) ; 4) = (optional) ACTION - valid values are: "RTN","SDHLAPT1",39,0) ; CALLED "RTN","SDHLAPT1",40,0) ; MESSAGE LEFT "RTN","SDHLAPT1",41,0) ; LETTER "RTN","SDHLAPT1",42,0) ; 5) = (optional) PATIENT PHONE Free-Text 4-20 characters "RTN","SDHLAPT1",43,0) ; 6) = NOT USED (optional) Comment 1-160 characters "RTN","SDHLAPT1",44,0) ; INP(18) = (optional) SERVICE CONNECTED PRIORITY valid values are NO YES "RTN","SDHLAPT1",45,0) ; INP(19) = (optional) SERVICE CONNECTED PERCENTAGE = numeric 0-100 "RTN","SDHLAPT1",46,0) ; INP(20) = (optional) MRTC calculated preferred dates separated by pipe |: "RTN","SDHLAPT1",47,0) ; Each date can be in external format with no time. "RTN","SDHLAPT1",48,0) ; INP(21) = (optional) CLINIC STOP pointer to CLINIC STOP file 40.7 "RTN","SDHLAPT1",49,0) ; used to populate the REQ SERVICE/SPECIALTY field in 409.85 "RTN","SDHLAPT1",50,0) ; INP(22) = (optional) Appointment Type ID pointer to APPOINTMENT TYPE file 409.1 "RTN","SDHLAPT1",51,0) ; INP(23) = (optional) Patient Status "RTN","SDHLAPT1",52,0) ; N = NEW "RTN","SDHLAPT1",53,0) ; E = ESTABLISHED "RTN","SDHLAPT1",54,0) ; INP(24) = (optional) MULT APPTS MADE "RTN","SDHLAPT1",55,0) ; list of child pointers to SDEC APPOINTMENT and/orSDEC APPT REQUEST files separated by pipe "RTN","SDHLAPT1",56,0) ; each pipe piece contains the following ~ pieces: "RTN","SDHLAPT1",57,0) ; 1. Appointment Id pointer to SDEC APPOINTMENT file 409.84 "RTN","SDHLAPT1",58,0) ; 2. Request Id pointer to SDEC APPT REQUEST file 409.85 "RTN","SDHLAPT1",59,0) ; INP(25) = (optional) PARENT REQUEST pointer to SDEC APPT REQUEST file 409.85 "RTN","SDHLAPT1",60,0) ; INP(26) = (optional) NLT (No later than) [CPRS RTC REQUIREMENT] "RTN","SDHLAPT1",61,0) ; INP(27) = (optional) PREREQ (Prerequisites) [CPRS RTC REQUIREMENT] "RTN","SDHLAPT1",62,0) ; INP(28) = (optional) ORDER IEN [CPRS RTC REQUIREMENT] "RTN","SDHLAPT1",63,0) N X,Y,%DT "RTN","SDHLAPT1",64,0) N DFN,MI,ARAPTYP,ARIEN,ARORIGDT,ARORIGDTI,ARINST,ARINSTI,ARTYPE,ARTEAM,ARPOS,ARSRVSP,ARCLIN "RTN","SDHLAPT1",65,0) N ARUSER,ARPRIO,ARREQBY,ARPROV,ARDAPTDT,ARCOMM,AREESTAT,AREDT,ARQUIT,ARNLT,ARORDN "RTN","SDHLAPT1",66,0) N FNUM,FDA,ARNEW,ARRET,ARMSG,ARDATA,ARERR,ARHOSN,AUDF,SDREC "RTN","SDHLAPT1",67,0) N ARMAI,ARMAN,ARMAR,ARPARENT,ARPATTEL,ARENPRI,ARSTOP,ARSVCCON,ARSVCCOP "RTN","SDHLAPT1",68,0) S (ARQUIT,AUDF)=0 "RTN","SDHLAPT1",69,0) S FNUM=$$FNUM^SDECAR "RTN","SDHLAPT1",70,0) S RET="" "RTN","SDHLAPT1",71,0) ; Use MERGE instead of SET so we can know if values were actually specified or not. "RTN","SDHLAPT1",72,0) ; This way, if a value is null, we will delete any previous value, "RTN","SDHLAPT1",73,0) ; but if it is missing, then we will just ignore it. "RTN","SDHLAPT1",74,0) M ARIEN=INP(1) "RTN","SDHLAPT1",75,0) S DFN=$G(INP(2)) "RTN","SDHLAPT1",76,0) I '+DFN S RET="-1^Invalid Patient ID." Q "RTN","SDHLAPT1",77,0) I '$D(^DPT(DFN,0)) S RET="-1^Invalid Patient ID" Q "RTN","SDHLAPT1",78,0) S AREDT=$P($G(INP(3)),":",1,2) "RTN","SDHLAPT1",79,0) S %DT="TX" S X=AREDT D ^%DT S AREDT=Y "RTN","SDHLAPT1",80,0) I Y=-1 S RET="-1^Invalid Origination date." Q "RTN","SDHLAPT1",81,0) S ARORIGDT=$P(AREDT,".",1) "RTN","SDHLAPT1",82,0) S ARINST=$G(INP(4)) I ARINST'="" D "RTN","SDHLAPT1",83,0) .I '+ARINST S ARINST=$O(^DIC(4,"B",ARINST,0)) "RTN","SDHLAPT1",84,0) M ARTYPE=INP(5) "RTN","SDHLAPT1",85,0) S ARCLIN=$G(INP(6)) "RTN","SDHLAPT1",86,0) I ARCLIN'="" D "RTN","SDHLAPT1",87,0) .I +ARCLIN=ARCLIN D "RTN","SDHLAPT1",88,0) ..I '$D(^SC(+ARCLIN,0)) S RET="-1^"_ARCLIN_" is an invalid Clinic ID." S ARQUIT=1 Q "RTN","SDHLAPT1",89,0) ..;S ARCLIN=$$GET1^DIQ(44,ARCLIN_",",.01) "RTN","SDHLAPT1",90,0) .I '(+ARCLIN=ARCLIN) D "RTN","SDHLAPT1",91,0) ..S ARCLIN=$O(^SC("B",ARCLIN,0)) "RTN","SDHLAPT1",92,0) ..I ARCLIN="" S RET="-1^"_ARCLIN_" is an invalid Clinic Name." S ARQUIT=1 Q "RTN","SDHLAPT1",93,0) Q:ARQUIT=1 "RTN","SDHLAPT1",94,0) S ARUSER=$G(INP(7)) "RTN","SDHLAPT1",95,0) I ARUSER'="" I '+ARUSER S ARUSER=$O(^VA(200,"B",ARUSER,0)) "RTN","SDHLAPT1",96,0) I ARUSER="" S ARUSER=DUZ "RTN","SDHLAPT1",97,0) S ARREQBY=$G(INP(9)) I ARREQBY'="" D "RTN","SDHLAPT1",98,0) .S ARREQBY=$S(ARREQBY="PATIENT":2,ARREQBY="PROVIDER":1,1:"") "RTN","SDHLAPT1",99,0) S ARPROV=$G(INP(10)) I ARPROV'="" I '+ARPROV S ARPROV=$O(^VA(200,"B",ARPROV,0)) "RTN","SDHLAPT1",100,0) S ARDAPTDT=INP(11) "RTN","SDHLAPT1",101,0) S %DT="" S X=$P($G(ARDAPTDT),"@",1) D ^%DT S ARPRIO=$S(Y=$P($$NOW^XLFDT,".",1):"A",1:"F") "RTN","SDHLAPT1",102,0) S ARDAPTDT=Y "RTN","SDHLAPT1",103,0) I Y=-1 S ARDAPTDT="" ;S RET=RET_"-1^Invalid Desired Date." Q "RTN","SDHLAPT1",104,0) S (INP(12),ARCOMM)=$TR($G(INP(12)),"^"," ") ;alb/sat 658 "RTN","SDHLAPT1",105,0) S ARENPRI=$G(INP(13)) D "RTN","SDHLAPT1",106,0) .S:ARENPRI'="" ARENPRI=$S(ARENPRI="GROUP 1":1,ARENPRI="GROUP 2":2,ARENPRI="GROUP3":3,ARENPRI="GROUP4":4,ARENPRI="GROUP 5":5,ARENPRI="GROUP 6":6,ARENPRI="GROUP 7":7,ARENPRI="GROUP 8":8,1:ARENPRI) "RTN","SDHLAPT1",107,0) S ARMAR=$G(INP(14)) I ARMAR'="" S ARMAR=$S(ARMAR="YES":1,1:0) "RTN","SDHLAPT1",108,0) M ARMAI=INP(15) "RTN","SDHLAPT1",109,0) M ARMAN=INP(16) "RTN","SDHLAPT1",110,0) S ARSVCCON=$G(INP(18)) S:ARSVCCON'="" ARSVCCON=$S(ARSVCCON="YES":1,1:0) "RTN","SDHLAPT1",111,0) M ARSVCCOP=INP(19) I $G(ARSVCCOP)'="" S ARSVCCOP=+$G(ARSVCCOP) S:(+ARSVCCOP<0)!(+ARSVCCOP>100) ARSVCCOP="" "RTN","SDHLAPT1",112,0) ;B "L+" "RTN","SDHLAPT1",113,0) S ARSTOP=$G(INP(21)) "RTN","SDHLAPT1",114,0) I ARSTOP'="",ARCLIN'="" S RET="-1^Cannot include both Clinic and Service." Q "RTN","SDHLAPT1",115,0) S ARAPTYP=+$G(INP(22)) I +ARAPTYP,'$D(^SD(409.1,ARAPTYP,0)) S ARAPTYP="" "RTN","SDHLAPT1",116,0) S ARPARENT=+$G(INP(25)) I +ARPARENT,'$D(^SDEC(409.85,+ARPARENT,0)) S ARPARENT="" "RTN","SDHLAPT1",117,0) S ARNLT=+$G(INP(26)) "RTN","SDHLAPT1",118,0) S ARPRER=$G(INP(27)) "RTN","SDHLAPT1",119,0) S ARORDN=+$G(INP(28)) "RTN","SDHLAPT1",120,0) ;CHECK FOR MISSING NLT,PREREQ,ORDER IEN ON MULTIPLE APPT REQUESTS "RTN","SDHLAPT1",121,0) I +ARPARENT>0&(+$G(INP(26))=0) D "RTN","SDHLAPT1",122,0) .S ARNLT=$P($G(^SDEC(409.85,+ARPARENT,7)),U,2) "RTN","SDHLAPT1",123,0) I +ARPARENT>0&($G(INP(27))="") D "RTN","SDHLAPT1",124,0) .N PRIEN,PR "RTN","SDHLAPT1",125,0) .S PRIEN=0 F S PRIEN=$O(^SDEC(409.85,+ARPARENT,8,PRIEN)) Q:PRIEN'>0 D "RTN","SDHLAPT1",126,0) ..S PR=$P($G(^SDEC(409.85,+ARPARENT,8,PRIEN,0)),"^") Q:PR="" "RTN","SDHLAPT1",127,0) ..S ARPRER=$S(ARPRER'="":ARPRER_";"_PR,1:PR) "RTN","SDHLAPT1",128,0) I +ARPARENT>0&(+$G(INP(28))=0) D "RTN","SDHLAPT1",129,0) .S ARORDN=$P($G(^SDEC(409.85,+ARPARENT,7)),U,1) "RTN","SDHLAPT1",130,0) ; "RTN","SDHLAPT1",131,0) S ARIEN=$G(ARIEN) "RTN","SDHLAPT1",132,0) S ARNEW=ARIEN="" "RTN","SDHLAPT1",133,0) I ARNEW D "RTN","SDHLAPT1",134,0) . S AUDF=1 "RTN","SDHLAPT1",135,0) . S FDA=$NA(FDA(FNUM,"+1,")) "RTN","SDHLAPT1",136,0) . S @FDA@(.01)=+DFN ;$S(+DFN:$P($G(^DPT(DFN,0)),U),1:DFN) "RTN","SDHLAPT1",137,0) . ;This handles the date/time coming in as "8/27/2014 12:00:00 AM" "RTN","SDHLAPT1",138,0) . S:$G(ARORIGDT)'="" @FDA@(1)=ARORIGDT "RTN","SDHLAPT1",139,0) . S:$G(ARINST)'="" @FDA@(2)=+ARINST "RTN","SDHLAPT1",140,0) . S:$G(ARTYPE)'="" @FDA@(4)=$S(ARTYPE="APPOINTMENT":"APPT",ARTYPE="MOBILE":"MOBILE",1:ARTYPE) "RTN","SDHLAPT1",141,0) . S:$G(ARCLIN)'="" @FDA@(8)=+ARCLIN "RTN","SDHLAPT1",142,0) . S:$G(ARSTOP)'="" @FDA@(8.5)=+ARSTOP "RTN","SDHLAPT1",143,0) . S:+ARAPTYP @FDA@(8.7)=+ARAPTYP "RTN","SDHLAPT1",144,0) . S:$G(ARUSER)'="" @FDA@(9)=+ARUSER "RTN","SDHLAPT1",145,0) . S:$G(AREDT)'="" @FDA@(9.5)=AREDT "RTN","SDHLAPT1",146,0) . S:$G(ARPRIO)'="" @FDA@(10)=ARPRIO "RTN","SDHLAPT1",147,0) . S:$G(ARENPRI)'="" @FDA@(10.5)=ARENPRI "RTN","SDHLAPT1",148,0) . S:$G(ARREQBY)'="" @FDA@(11)=ARREQBY "RTN","SDHLAPT1",149,0) . S:$G(ARPROV)'="" @FDA@(12)=+ARPROV "RTN","SDHLAPT1",150,0) . S:$G(ARSVCCOP)'="" @FDA@(14)=ARSVCCOP "RTN","SDHLAPT1",151,0) . S:$G(ARSVCCON)'="" @FDA@(15)=+ARSVCCON "RTN","SDHLAPT1",152,0) . S:$G(ARDAPTDT)'="" @FDA@(22)=ARDAPTDT "RTN","SDHLAPT1",153,0) . S:$G(ARNLT)'="" @FDA@(47)=ARNLT "RTN","SDHLAPT1",154,0) . D FDAPRER(.FDA,ARPRER,"+1") "RTN","SDHLAPT1",155,0) . S:$G(ARORDN)'="" @FDA@(46)=ARORDN "RTN","SDHLAPT1",156,0) . S @FDA@(23)="O" "RTN","SDHLAPT1",157,0) . S:$G(ARCOMM)'="" @FDA@(25)=ARCOMM "RTN","SDHLAPT1",158,0) . S:$G(ARMAR)'="" @FDA@(41)=ARMAR "RTN","SDHLAPT1",159,0) . I +ARMAR,$G(ARMAI)'="" S @FDA@(42)=ARMAI "RTN","SDHLAPT1",160,0) . I +ARMAR,$G(ARMAN)'="" S @FDA@(43)=ARMAN "RTN","SDHLAPT1",161,0) . S:$G(INP(23))'="" @FDA@(.02)=$S(INP(23)="N":"N",INP(23)="NEW":"N",INP(23)="E":"E",INP(23)="ESTABLISHED":"E",1:"") "RTN","SDHLAPT1",162,0) . S:+ARPARENT @FDA@(43.8)=+ARPARENT "RTN","SDHLAPT1",163,0) E D "RTN","SDHLAPT1",164,0) . S ARIEN=ARIEN_"," ; Append the comma for both "RTN","SDHLAPT1",165,0) . K ARDATA,ARERR "RTN","SDHLAPT1",166,0) . D GETS^DIQ(FNUM,ARIEN,"*","IE","ARDATA","ARERR") "RTN","SDHLAPT1",167,0) . I $D(ARERR) M ARMSG=ARERR K FDA Q "RTN","SDHLAPT1",168,0) . S FDA=$NA(FDA(FNUM,ARIEN)) "RTN","SDHLAPT1",169,0) . I $D(ARORIGDT) D "RTN","SDHLAPT1",170,0) . . S ARORIGDT=$P(ARORIGDT,"@",1) S %DT="" S X=ARORIGDT D ^%DT S ARORIGDTI=Y "RTN","SDHLAPT1",171,0) . . I ARORIGDTI'=ARDATA(FNUM,ARIEN,1,"I") S @FDA@(1)=$S(ARORIGDT="":"@",1:ARORIGDT) "RTN","SDHLAPT1",172,0) . I $D(ARINST),ARINST'=ARDATA(FNUM,ARIEN,2,"I") S @FDA@(2)=+ARINST "RTN","SDHLAPT1",173,0) . I $D(ARTYPE),ARTYPE'=ARDATA(FNUM,ARIEN,4,"E") S @FDA@(4)=$S(ARTYPE="APPOINTMENT":"APPT",ARTYPE="MOBILE":"MOBILE",1:ARTYPE) "RTN","SDHLAPT1",174,0) . I ARCLIN'="",ARCLIN'=ARDATA(FNUM,ARIEN,8,"I") S @FDA@(8)=+ARCLIN,AUDF=1 S:ARDATA(FNUM,ARIEN,8.5,"I")'="" @FDA@(8.5)="@" "RTN","SDHLAPT1",175,0) . I ARSTOP'="",ARSTOP'=ARDATA(FNUM,ARIEN,8.5,"I") S @FDA@(8.5)=+ARSTOP,AUDF=1 S:ARDATA(FNUM,ARIEN,8,"I")'="" @FDA@(8)="@" "RTN","SDHLAPT1",176,0) . S:+ARAPTYP @FDA@(8.7)=+ARAPTYP "RTN","SDHLAPT1",177,0) . I $D(ARUSER),ARUSER'=ARDATA(FNUM,ARIEN,9,"I") S @FDA@(9)=+ARUSER "RTN","SDHLAPT1",178,0) . I $D(AREDT),AREDT'=$G(ARDATA(FNUM,ARIEN,9.5,"I")) S @FDA@(9.5)=AREDT "RTN","SDHLAPT1",179,0) . I $D(ARPRIO),ARPRIO'=ARDATA(FNUM,ARIEN,10,"I") S @FDA@(10)=$S(ARPRIO="":"@",1:ARPRIO) "RTN","SDHLAPT1",180,0) . I $D(ARENPRI),ARENPRI'=ARDATA(FNUM,ARIEN,10.5,"E") S @FDA@(10.5)=ARENPRI "RTN","SDHLAPT1",181,0) . I $D(ARREQBY),ARREQBY'=ARDATA(FNUM,ARIEN,11,"I") S @FDA@(11)=$S(ARREQBY="":"@",1:ARREQBY) "RTN","SDHLAPT1",182,0) . I $D(ARPROV),ARPROV'=ARDATA(FNUM,ARIEN,12,"I") S @FDA@(12)=+ARPROV "RTN","SDHLAPT1",183,0) . I $D(ARSVCCOP),ARSVCCOP'=$G(ARDATA(FNUM,ARIEN,14,"I")) S @FDA@(14)=ARSVCCOP "RTN","SDHLAPT1",184,0) . I $D(ARSVCCON),ARSVCCON'=ARDATA(FNUM,ARIEN,15,"E") S @FDA@(15)=+ARSVCCON "RTN","SDHLAPT1",185,0) . I $D(ARDAPTDT),ARDAPTDT'=ARDATA(FNUM,ARIEN,22,"I") S @FDA@(22)=$S(ARDAPTDT="":"@",1:ARDAPTDT) "RTN","SDHLAPT1",186,0) . I $D(ARCOMM),ARCOMM'=ARDATA(FNUM,ARIEN,25,"I") S @FDA@(25)=$S(ARCOMM="":"@",1:ARCOMM) "RTN","SDHLAPT1",187,0) . S:$G(ARMAR)'="" @FDA@(41)=ARMAR "RTN","SDHLAPT1",188,0) . S:$G(ARMAI)'="" @FDA@(42)=ARMAI "RTN","SDHLAPT1",189,0) . S:$G(ARMAN)'="" @FDA@(43)=ARMAN "RTN","SDHLAPT1",190,0) . S:$G(ARNLT)'="" @FDA@(47)=ARNLT "RTN","SDHLAPT1",191,0) . D DELPRER(+ARIEN) "RTN","SDHLAPT1",192,0) . D FDAPRER(.FDA,ARPRER,+ARIEN) "RTN","SDHLAPT1",193,0) . S:$G(ARORDN)'="" @FDA@(46)=ARORDN "RTN","SDHLAPT1",194,0) . S:$G(INP(23))'="" @FDA@(.02)=$S(INP(23)="N":"N",INP(23)="NEW":"N",INP(23)="E":"E",INP(23)="ESTABLISHED":"E",1:"") "RTN","SDHLAPT1",195,0) . S:+ARPARENT @FDA@(43.8)=+ARPARENT "RTN","SDHLAPT1",196,0) ; Only call UPDATE^DIE if there are any array entries in FDA "RTN","SDHLAPT1",197,0) D:$D(FDA)>9 UPDATE^DIE("","FDA","ARRET","ARMSG") "RTN","SDHLAPT1",198,0) I $D(ARMSG) D "RTN","SDHLAPT1",199,0) . F MI=1:1:$G(ARMSG("DIERR")) S RET="-1^"_$G(ARMSG("DIERR",MI,"TEXT",1)) "RTN","SDHLAPT1",200,0) . ;S RET=RET_$C(31) "RTN","SDHLAPT1",201,0) Q:$D(ARMSG) "RTN","SDHLAPT1",202,0) S ARINSTI=$P($G(^SDEC(409.85,$S(+ARIEN:ARIEN,1:ARRET(1)),0)),U,3) "RTN","SDHLAPT1",203,0) ;I $G(INP(17))'="" D AR23(INP(17),$S(+ARIEN:ARIEN,1:ARRET(1))) ;patient contacts "RTN","SDHLAPT1",204,0) ;I +ARMAR,$G(INP(20))'="" D AR435(INP(20),$S(+ARIEN:ARIEN,1:ARRET(1))) ;MRTC CALC PREF DATES "RTN","SDHLAPT1",205,0) I +AUDF D ARAUD($S(+ARIEN:+ARIEN,1:ARRET(1)),ARCLIN,ARSTOP) ;VS AUDIT "RTN","SDHLAPT1",206,0) I $G(INP(24))'="" N SDI F SDI=1:1:$L(INP(24),"|") S SDREC=$P(INP(24),"|",SDI) D AR433($S(+ARIEN:+ARIEN,1:ARRET(1)),SDREC) "RTN","SDHLAPT1",207,0) I +ARPARENT D AR433(+ARPARENT,"~"_$S(+ARIEN:+ARIEN,1:ARRET(1))) "RTN","SDHLAPT1",208,0) I +$G(ARRET(1)) S RET="1^"_ARRET(1) "RTN","SDHLAPT1",209,0) E S RET="1^"_+ARIEN "RTN","SDHLAPT1",210,0) Q "RTN","SDHLAPT1",211,0) ; "RTN","SDHLAPT1",212,0) FDAPRER(FDA,ARPRER,ARIEN) ;Setup the FDA array for the PREREQUISITE multiple (#48) "RTN","SDHLAPT1",213,0) N ASEQ,DELIM,PC,PR "RTN","SDHLAPT1",214,0) Q:$G(ARPRER)="" "RTN","SDHLAPT1",215,0) S DELIM=";",ASEQ=80 "RTN","SDHLAPT1",216,0) F PC=1:1:$L(ARPRER,DELIM) D "RTN","SDHLAPT1",217,0) .S PR=$P(ARPRER,DELIM,PC) Q:PR="" "RTN","SDHLAPT1",218,0) .S ASEQ=ASEQ+1,FDA(409.8548,"+"_ASEQ_","_ARIEN_",",.01)=PR "RTN","SDHLAPT1",219,0) Q "RTN","SDHLAPT1",220,0) ; "RTN","SDHLAPT1",221,0) DELPRER(ARIEN) ;Delete all entries in the PREREQUISITE multiple (#48) "RTN","SDHLAPT1",222,0) N DIK,DA "RTN","SDHLAPT1",223,0) Q:$G(ARIEN)'=+$G(ARIEN) Q:ARIEN'>0 "RTN","SDHLAPT1",224,0) S DIK="^SDEC(409.85,"_ARIEN_",8,",DA(1)=ARIEN "RTN","SDHLAPT1",225,0) S DA=0 F S DA=$O(^SDEC(409.85,ARIEN,8,DA)) Q:DA'>0 D ^DIK "RTN","SDHLAPT1",226,0) Q "RTN","SDHLAPT1",227,0) ; "RTN","SDHLAPT1",228,0) GETPRER(RET,ARIEN) ;Return the values in the PREREQUISITE multiple (#48) "RTN","SDHLAPT1",229,0) N CC,PR "RTN","SDHLAPT1",230,0) I $G(^SDEC(409.85,+$G(ARIEN),0))="" S RET="-1^Invalid SDEC APPT REQUEST id "_$G(ARIEN) Q "RTN","SDHLAPT1",231,0) S RET="" "RTN","SDHLAPT1",232,0) S CC=0 F S CC=$O(^SDEC(409.85,ARIEN,8,CC)) Q:CC'>0 D "RTN","SDHLAPT1",233,0) .S PR=$P($G(^SDEC(409.85,ARIEN,8,CC,0)),U,1) Q:PR="" "RTN","SDHLAPT1",234,0) .S RET=$S(RET'="":RET_U_PR,1:PR) "RTN","SDHLAPT1",235,0) Q "RTN","SDHLAPT1",236,0) ; "RTN","SDHLAPT1",237,0) ARAUD(ARIEN,ARCLIN,ARSTOP,DATE,USER) ;populate VS AUDIT multiple field 45 "RTN","SDHLAPT1",238,0) ; ARIEN - (required) pointer to SDEC APPT REQUEST file 409.85 "RTN","SDHLAPT1",239,0) ; ARCLIN - (optional) pointer to HOSPITAL LOCATION file 44 "RTN","SDHLAPT1",240,0) ; ARSTOP - (optional) pointer to CLINIC STOP file "RTN","SDHLAPT1",241,0) ; DATE - (optional) date/time in fileman format "RTN","SDHLAPT1",242,0) N SDFDA,SDP,SDPN "RTN","SDHLAPT1",243,0) S ARIEN=$G(ARIEN) Q:ARIEN="" "RTN","SDHLAPT1",244,0) S ARCLIN=$G(ARCLIN) "RTN","SDHLAPT1",245,0) S ARSTOP=$G(ARSTOP) "RTN","SDHLAPT1",246,0) S SDP=$O(^SDEC(409.85,ARIEN,6,9999999),-1) "RTN","SDHLAPT1",247,0) I +SDP S SDPN=^SDEC(409.85,ARIEN,6,SDP,0) I $P(SDPN,U,3)=ARCLIN,$P(SDPN,U,4)=ARSTOP Q "RTN","SDHLAPT1",248,0) S DATE=$G(DATE) S:DATE="" DATE=$E($$NOW^XLFDT,1,12) "RTN","SDHLAPT1",249,0) S USER=$G(USER) S:USER="" USER=DUZ "RTN","SDHLAPT1",250,0) S SDFDA(409.8545,"+1,"_ARIEN_",",.01)=DATE "RTN","SDHLAPT1",251,0) S SDFDA(409.8545,"+1,"_ARIEN_",",1)=USER "RTN","SDHLAPT1",252,0) S:ARCLIN'="" SDFDA(409.8545,"+1,"_ARIEN_",",2)=ARCLIN "RTN","SDHLAPT1",253,0) S:ARSTOP'="" SDFDA(409.8545,"+1,"_ARIEN_",",3)=ARSTOP "RTN","SDHLAPT1",254,0) D UPDATE^DIE("","SDFDA") "RTN","SDHLAPT1",255,0) Q "RTN","SDHLAPT1",256,0) ; "RTN","SDHLAPT1",257,0) AR433(ARIEN,SDEC) ;set MULT APPTS MADE "RTN","SDHLAPT1",258,0) ;INPUT: "RTN","SDHLAPT1",259,0) ; ARIEN = (required) pointer to SDEC APPT REQUEST file 409.85 "RTN","SDHLAPT1",260,0) ; SDEC = (required) child pointers to SDEC APPOINTMENT and SDEC APPTREQUEST file separated by pipe "RTN","SDHLAPT1",261,0) ; each pipe piece contains the following ~ pieces: "RTN","SDHLAPT1",262,0) ; 1. Appointment Id pointer to SDEC APPOINTMENT file 409.84 "RTN","SDHLAPT1",263,0) ; 2. Request Id pointer to SDEC APPT REQUEST file 409.85 "RTN","SDHLAPT1",264,0) N SDAPP,SDFDA,SDI,SDIEN "RTN","SDHLAPT1",265,0) S ARIEN=$G(ARIEN) "RTN","SDHLAPT1",266,0) Q:'$D(^SDEC(409.85,ARIEN,0)) "RTN","SDHLAPT1",267,0) S SDEC=$G(SDEC) "RTN","SDHLAPT1",268,0) F SDI=1:1:$L(SDEC,"|") D "RTN","SDHLAPT1",269,0) .K SDFDA "RTN","SDHLAPT1",270,0) .S SDAPP=$P(SDEC,"|",SDI) "RTN","SDHLAPT1",271,0) .I $P(SDAPP,"~",2)="",$P(SDAPP,"~",1)'="" S $P(SDAPP,"~",2)=$P($$GET1^DIQ(409.84,+SDAPP_",",.22,"I"),";",1) "RTN","SDHLAPT1",272,0) .Q:$P(SDAPP,"~",2)="" "RTN","SDHLAPT1",273,0) .S SDIEN=$O(^SDEC(409.85,ARIEN,2,"B",$P(SDAPP,"~",2),0)) "RTN","SDHLAPT1",274,0) .S SDIEN=$S(SDIEN'="":SDIEN,1:"+1") "RTN","SDHLAPT1",275,0) .I $D(^SDEC(409.85,+$P(SDAPP,"~",2),0)) S SDFDA(409.852,SDIEN_","_ARIEN_",",.01)=+$P(SDAPP,"~",2) "RTN","SDHLAPT1",276,0) .I $D(^SDEC(409.84,+$P(SDAPP,"~",1),0)) S SDFDA(409.852,SDIEN_","_ARIEN_",",.02)=+$P(SDAPP,"~",1) "RTN","SDHLAPT1",277,0) .D:$D(SDFDA) UPDATE^DIE("","SDFDA") "RTN","SDHLAPT1",278,0) Q "RTN","SDHLAPT1",279,0) AR433D(SDEC) ;delete MULT APPTS MADE "RTN","SDHLAPT1",280,0) ;INPUT: "RTN","SDHLAPT1",281,0) ; SDEC = (required) pointers to SDEC APPOINTMENT file 409.84 separated by pipe "RTN","SDHLAPT1",282,0) N ARIEN,DFN,DIEN,SDAPP,SDFDA,SDI,SDJ,SDTYP "RTN","SDHLAPT1",283,0) S SDEC=$G(SDEC) "RTN","SDHLAPT1",284,0) F SDI=1:1:$L(SDEC,"|") D "RTN","SDHLAPT1",285,0) .S SDAPP=$P(SDEC,"|",SDI) "RTN","SDHLAPT1",286,0) .Q:'$D(^SDEC(409.84,SDAPP,0)) "RTN","SDHLAPT1",287,0) .S DFN=$$GET1^DIQ(409.84,SDAPP_",",.05,"I") "RTN","SDHLAPT1",288,0) .S SDTYP=$$GET1^DIQ(409.84,SDAPP_",",.22,"I"),DIEN=$P(SDTYP,";",1) "RTN","SDHLAPT1",289,0) .I $P(SDTYP,";",2)="SDEC(409.85," S ARIEN="" F S ARIEN=$O(^SDEC(409.85,"B",DFN,ARIEN)) Q:ARIEN="" D ; alb/jsm 658 "RTN","SDHLAPT1",290,0) ..S SDJ="" F S SDJ=$O(^SDEC(409.85,ARIEN,2,"B",DIEN,SDJ)) Q:SDJ="" D "RTN","SDHLAPT1",291,0) ...S SDFDA(409.852,SDJ_","_ARIEN_",",.01)="@" "RTN","SDHLAPT1",292,0) ...D UPDATE^DIE("","SDFDA") "RTN","SDHLAPT1",293,0) Q "RTN","SDHLAPT1",294,0) AR438(ARIEN,SDPARENT,SDEC) ;set PARENT REQUEST field 43.8; set as child in MULTAPPTS MADE in parent request "RTN","SDHLAPT1",295,0) N SDFDA "RTN","SDHLAPT1",296,0) I $G(SDPARENT)'="" S SDFDA(409.85,ARIEN_",",43.8)=SDPARENT D UPDATE^DIE("","SDFDA") "RTN","SDHLAPT1",297,0) Q "RTN","SDHLAPT1",298,0) ; "RTN","SDHLAPT1",299,0) AR435(SDDT,ARIEN) ;set dates into MRTC CALC PREF DATES multiple field 43.5 "RTN","SDHLAPT1",300,0) ;INPUT: "RTN","SDHLAPT1",301,0) ; ARIEN - Requested date ID pointer to SDEC REQUESTED APPT file 409.85 "RTN","SDHLAPT1",302,0) ; SDDT - MRTC calculated preferred dates separated by pipe |: "RTN","SDHLAPT1",303,0) ; Each date can be in external format with no time. "RTN","SDHLAPT1",304,0) N SDI,SDJ,SDFDA,X,Y,%DT "RTN","SDHLAPT1",305,0) F SDI=1:1:$L(SDDT,"|") D "RTN","SDHLAPT1",306,0) .S %DT="" S X=$P($P(SDDT,"|",SDI),"@",1) D ^%DT S SDJ=Y "RTN","SDHLAPT1",307,0) .Q:SDJ=-1 "RTN","SDHLAPT1",308,0) .Q:$O(^SDEC(409.85,ARIEN,5,"B",SDJ,0)) ;don't add duplicates "RTN","SDHLAPT1",309,0) .S SDFDA(409.851,"+1,"_ARIEN_",",.01)=SDJ "RTN","SDHLAPT1",310,0) .D UPDATE^DIE("","SDFDA") "RTN","SDHLAPT1",311,0) Q "RTN","SDHLAPT1",312,0) ; "RTN","SDHLAPT1",313,0) WLACT(NAME) ; "RTN","SDHLAPT1",314,0) N ACTIVE,H "RTN","SDHLAPT1",315,0) S ACTIVE="" "RTN","SDHLAPT1",316,0) S H="" F S H=$O(^DIC(40.7,"B",NAME,H)) Q:H="" D Q:ACTIVE'="" "RTN","SDHLAPT1",317,0) .I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDHLAPT1",318,0) .S ACTIVE=H "RTN","SDHLAPT1",319,0) Q ACTIVE "RTN","SDHLAPT1",320,0) ; "RTN","SDHLAPT1",321,0) AR23(INP17,ARI) ;Patient Contacts "RTN","SDHLAPT1",322,0) N STR17,ARASD,ARASDH,ARDATA1,ARERR1,ARI1,ARIENS,ARIENS1,ARRET1,FDA "RTN","SDHLAPT1",323,0) N ARDT,ARUSR,X,Y,%DT "RTN","SDHLAPT1",324,0) S ARIENS=ARI_"," "RTN","SDHLAPT1",325,0) F ARI1=1:1:$L(INP17,"::") D "RTN","SDHLAPT1",326,0) .S STR17=$P(INP17,"::",ARI1) "RTN","SDHLAPT1",327,0) .K FDA "RTN","SDHLAPT1",328,0) .S %DT="T" S X=$P($P(STR17,"~~",1),":",1,2) D ^%DT S ARASD=Y "RTN","SDHLAPT1",329,0) .I (ARASD=-1)!(ARASD="") Q "RTN","SDHLAPT1",330,0) .S ARDT=$P($P(STR17,"~~",1),":",1,2) "RTN","SDHLAPT1",331,0) .S ARASDH="" ;$O(^SDEC(409.85,ARI,4,"B",ARASD,0)) "RTN","SDHLAPT1",332,0) .S ARIENS1=$S(ARASDH'="":ARASDH,1:"+1")_","_ARIENS "RTN","SDHLAPT1",333,0) .S FDA=$NA(FDA(409.8544,ARIENS1)) "RTN","SDHLAPT1",334,0) .I ARASDH'="" D "RTN","SDHLAPT1",335,0) ..D GETS^DIQ(409.8544,ARIENS1,"*","IE","ARDATA1","ARERR1") "RTN","SDHLAPT1",336,0) ..I $P(STR17,"~~",1)'="" S @FDA@(.01)=ARDT ;DATE ENTERED external date/time "RTN","SDHLAPT1",337,0) ..I $P(STR17,"~~",2)'="" S ARUSR=$P(STR17,"~~",2) S @FDA@(2)=$S(ARUSR="":"@",+ARUSR:$P($G(^VA(200,ARUSR,0)),U,1),1:ARUSER) ;PC ENTERED BY USER "RTN","SDHLAPT1",338,0) ..I $P(STR17,"~~",4)'="" S @FDA@(3)=$P(STR17,"~~",4) ;ACTION C=Called; M=Message Left; L=LETTER "RTN","SDHLAPT1",339,0) ..I $P(STR17,"~~",5)'="" S @FDA@(4)=$P(STR17,"~~",5) ;PATIENT PHONE "RTN","SDHLAPT1",340,0) ..;I $P(STR17,"~~",6)'="" S @FDA@(5)=$E($P(STR17,"~~",6),1,160) ;COMMENT "RTN","SDHLAPT1",341,0) .I ARASDH="" D "RTN","SDHLAPT1",342,0) ..I $P(STR17,"~~",1)'="" S @FDA@(.01)=ARDT ;DATE ENTERED external date/time "RTN","SDHLAPT1",343,0) ..I $P(STR17,"~~",2)'="" S ARUSR=$P(STR17,"~~",2) S @FDA@(2)=$S(ARUSR="":"@",+ARUSR:$P($G(^VA(200,ARUSR,0)),U,1),1:ARUSR) ;PC ENTERED BY USER "RTN","SDHLAPT1",344,0) ..I $P(STR17,"~~",4)'="" S @FDA@(3)=$P(STR17,"~~",4) ;ACTION C=Called; M=Message Left; L=LETTER "RTN","SDHLAPT1",345,0) ..I $P(STR17,"~~",5)'="" S @FDA@(4)=$P(STR17,"~~",5) ;PATIENT PHONE "RTN","SDHLAPT1",346,0) ..;I $P(STR17,"~~",6)'="" S @FDA@(5)=$E($P(STR17,"~~",6),1,160) ;COMMENT "RTN","SDHLAPT1",347,0) .D:$D(@FDA) UPDATE^DIE("E","FDA","ARRET1","ARMSG1") "RTN","SDHLAPT1",348,0) Q "RTN","SDHLAPT1",349,0) UPDATE(ARIEN,APPDT,SDCL,SVCP,SVCPR,NOTE,SDAPPTYP) ;update REQ APPT REQUEST at apointment add "RTN","SDHLAPT1",350,0) ;INPUT: "RTN","SDHLAPT1",351,0) ; ARIEN = Appt Request pointer to SD WAIT LIST file 409.85 "RTN","SDHLAPT1",352,0) ; APPDT = Appointment date/time (Scheduled Date of appt) in fm format "RTN","SDHLAPT1",353,0) ; SDCL = Clinic ID pointer to HOSPITAL LOCATION file 44 "RTN","SDHLAPT1",354,0) ; SVCP = Service Connected Percentage numeric 0-100 "RTN","SDHLAPT1",355,0) ; SVCPR = Service Connected Priority 0:NO 1:YES "RTN","SDHLAPT1",356,0) ; NOTE = Comment only 1st 60 characters are used "RTN","SDHLAPT1",357,0) ; SDAPPTYP = (optional) Appointment type ID pointer to APPOINTMENT TYPE file 409.1 "RTN","SDHLAPT1",358,0) ; "RTN","SDHLAPT1",359,0) ;all input must be verified by calling routine "RTN","SDHLAPT1",360,0) N SDDIV,SDFDA,SDSN,SDMSG "RTN","SDHLAPT1",361,0) S:+$G(SDAPPTYP) SDFDA(409.85,ARIEN_",",8.7)=SDAPPTYP "RTN","SDHLAPT1",362,0) S SDFDA(409.85,ARIEN_",",13)=APPDT ;SCHEDULED DATEOF APPT = APPDT (SDECSTART) "RTN","SDHLAPT1",363,0) S SDFDA(409.85,ARIEN_",",13.1)=$P($$NOW^XLFDT,".",1) ;DATE APPT. MADE= TODAY "RTN","SDHLAPT1",364,0) S SDFDA(409.85,ARIEN_",",13.2)=SDCL ;APPT CLINIC= SDCL (SDECSCD) "RTN","SDHLAPT1",365,0) S SDFDA(409.85,ARIEN_",",13.3)=$P($G(^SC(SDCL,0)),U,4) ;APPT INSTITUTION = Get from 44 using SDCL "RTN","SDHLAPT1",366,0) S SDFDA(409.85,ARIEN_",",13.4)=$P($G(^SC(SDCL,0)),U,7) ;APPT STOP CODE= Get from 44 using SDCL "RTN","SDHLAPT1",367,0) S SDDIV=$P($G(^SC(SDCL,0)),U,15) "RTN","SDHLAPT1",368,0) S SDSN=$S(SDDIV'="":$P($G(^DG(40.8,SDDIV,0)),U,2),1:"") "RTN","SDHLAPT1",369,0) S SDFDA(409.85,ARIEN_",",13.6)=SDSN ;APPT STATION NMBER "RTN","SDHLAPT1",370,0) S SDFDA(409.85,ARIEN_",",13.7)=DUZ ;APPT CLERK= Current User "RTN","SDHLAPT1",371,0) S SDFDA(409.85,ARIEN_",",13.8)="R" ;APPT STATUS= R:Scheduled/Kept "RTN","SDHLAPT1",372,0) S:SVCP'="" SDFDA(409.85,ARIEN_",",14)=SVCP ;SERVICE CONNECTED PERCENTAGE = SVCP (SDSVCP) "RTN","SDHLAPT1",373,0) S:SVCPR'="" SDFDA(409.85,ARIEN_",",15)=SVCPR ;SERVICE CONNECTED PRIORITY = SVCPR (SDSVCPR) "RTN","SDHLAPT1",374,0) S:$G(NOTE)'="" SDFDA(409.85,ARIEN_",",25)=NOTE "RTN","SDHLAPT1",375,0) D UPDATE^DIE("","SDFDA","","SDMSG") "RTN","SDHLAPT1",376,0) Q "RTN","SDHLAPT1",377,0) GETAPP(DFN,SDECRES,STARTDT) ; returns the appointment id in 409.84 "RTN","SDHLAPT1",378,0) ;.S SDECAPTID=$O(^SDEC(409.84,"ARSRC",SDECRES,STARTDT,"")) "RTN","SDHLAPT1",379,0) N APT,XX "RTN","SDHLAPT1",380,0) S APT=0 "RTN","SDHLAPT1",381,0) S XX=0 F S XX=$O(^SDEC(409.84,"ARSRC",SDECRES,STARTDT,XX)) Q:XX="" D "RTN","SDHLAPT1",382,0) .I $P(^SDEC(409.84,XX,0),"^",5)=DFN S APT=XX Q "RTN","SDHLAPT1",383,0) Q APT "RTN","SDHLAPT2") 0^18^B22091553^n/a "RTN","SDHLAPT2",1,0) SDHLAPT2 ;MS/PB - VISTA SCHEDULING RPCS ;Nov 14, 2014 "RTN","SDHLAPT2",2,0) ;;5.3;Scheduling;**704**;Nov 14, 2018;Build 64 "RTN","SDHLAPT2",3,0) ; "RTN","SDHLAPT2",4,0) Q "RTN","SDHLAPT2",5,0) PROVSITE(X) ; "RTN","SDHLAPT2",6,0) N PROVAPT "RTN","SDHLAPT2",7,0) M PROVAPT=X "RTN","SDHLAPT2",8,0) Q:'$D(PROVAPT) "RTN","SDHLAPT2",9,0) N SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT,SDEL "RTN","SDHLAPT2",10,0) S (SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT,SDEL)="" "RTN","SDHLAPT2",11,0) S XX=0 F S XX=$O(PROVAPT(XX)) Q:XX'>0 D "RTN","SDHLAPT2",12,0) . N STM,SEG "RTN","SDHLAPT2",13,0) . I $P(SEG,"|")="SCH" D PARSESEG^SDHL7APU(SEG,.SCH,.HL) D "RTN","SDHLAPT2",14,0) . . S TM=$G(SCH(11,1,4)),STM=$P(TM,":",1,2)_":00Z",SDECLEN=$G(SEG,9) "RTN","SDHLAPT2",15,0) . . S SDECATID=$G(SCH,6),SDECCR=$G(SEG(6,1,2)) "RTN","SDHLAPT2",16,0) . . S FLMNFMT=$$CONVTIME^SDHL7APU(STM),TMPSTART=FLMNFMT,SDECSTART=$$FMTE^XLFDT(FLMNFMT),SDECEND=$$FMADD^XLFDT(FLMNFMT,,,SDECLEN,0) "RTN","SDHLAPT2",17,0) . . ;I $P(PROVAPT(XX+1),"|")="NTE" S SDECNOTE=$P($G(PROVAPT(XX+1)),"|",4) "RTN","SDHLAPT2",18,0) . . ;S MSGARY("CNCLRSN")=$G(SCH(6,1,2)) "RTN","SDHLAPT2",19,0) . . ;S MSGARY("CANCODE")=$G(SCH(6,1,4)) "RTN","SDHLAPT2",20,0) . . ;S MSGARY("CANREMARKS")=$G(SCH(6,1,5)) "RTN","SDHLAPT2",21,0) . I $P(SEG,"|")="AIL" D AIL "RTN","SDHLAPT2",22,0) S OVB=1,SDEL="" "RTN","SDHLAPT2",23,0) D APPADD^SDEC07(.SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,SDPARENT,SDEL) ;ADD NEW APPOINTMENT "RTN","SDHLAPT2",24,0) Q "RTN","SDHLAPT2",25,0) AIL ; "RTN","SDHLAPT2",26,0) D PARSESEG^SDHL7APU(SEG,.AIL,.HL) "RTN","SDHLAPT2",27,0) S SDCL=+$G(AIL(3,1,1)) N RET,RET1 D RESLKUP^SDHL7APU(SDCL) S SDECRES=RET1 "RTN","SDHLAPT2",28,0) N STCREC,CONSID,MTC "RTN","SDHLAPT2",29,0) S STCREC="" "RTN","SDHLAPT2",30,0) S SDAPTYP="" "RTN","SDHLAPT2",31,0) S (SDPARENT)=$G(AIL(1,4,1,4)) "RTN","SDHLAPT2",32,0) I $G(AIL(1,4,1,2))="C" S CONSID=$G(AIL(1,4,1,1)),SDAPTYP="C|"_$G(AIL(1,4,1,1)) "RTN","SDHLAPT2",33,0) I $G(AIL(1,4,1,2))="R" D "RTN","SDHLAPT2",34,0) . S MTC=$P($G(^SDEC(409.85,+$G(SDPARENT),3)),"^"),SDMRTC=$S(MTC>0:1,1:0) "RTN","SDHLAPT2",35,0) . ;get the last child sequence number and set RTCID and MSGARY("RTCID") = to last sequence number plus 1 "RTN","SDHLAPT2",36,0) . K X12,RTCID S RTCID="",X12=0 I +$L(SDPARENT) F S X12=$O(^SDEC(409.85,SDPARENT,2,X12)) Q:X12'>0 S RTCID=X12+1 "RTN","SDHLAPT2",37,0) . S:$G(MTC)=1 SDAPTYP="R|"_$G(RTCID) ; if this is a multi RTC order $P(SDAPTYP,"|",2) is the next child sequence number, else it is null "RTN","SDHLAPT2",38,0) . Q "RTN","SDHLAPT2",39,0) ;Get parent rtc order if it is a multi appointment rtc "RTN","SDHLAPT2",40,0) S:$G(AIL(1,4,1,2))="A" SDAPTYP="A|" "RTN","SDHLAPT2",41,0) I $P(PROVAPT(XX+1),"|")="NTE" S SDECNOTE=$P($G(PROVAPT(XX+1)),"|",4) "RTN","SDHLAPT2",42,0) ; "RTN","SDHLAPT2",43,0) Q "RTN","SDHLAPT2",44,0) NEWTIME ; "RTN","SDHLAPT2",45,0) N ST1,ST12 "RTN","SDHLAPT2",46,0) S ST12=$P(SDTMPHL(1),"|",12) "RTN","SDHLAPT2",47,0) S ST1=$P(ST12,"^",4) ;2019-02-19T19:00 "RTN","SDHLAPT2",48,0) S ST1=$TR(ST1,"-",""),ST1=$TR(ST1,"T",""),ST1=$TR(ST1,":",""),ST1=+ST1 "RTN","SDHLAPT2",49,0) S TZONE=$$GET1^DIQ(4.3,"1,",1,"I"),DIFF=$$GET1^DIQ(4.4,$G(TZONE)_",",2,"E")*(-1) "RTN","SDHLAPT2",50,0) S ST1=$$HL7TFM^XLFDT(ST1,"U"),ST1=$$FMADD^XLFDT(ST1,,-$G(DIFF),5) "RTN","SDHLAPT2",51,0) S ST1=$$FMTHL7^XLFDT(ST1) "RTN","SDHLAPT2",52,0) S ST1=$$FMTE^XLFDT(ST1) "RTN","SDHLAPT2",53,0) S ST1=$E(ST1,1,4)_"-"_$E(ST1,5,6)_"-"_$E(ST1,7,8)_"T"_$E(ST1,9,10)_":"_$E(ST1,11,12)_":"_$E(ST1,13,14)_"Z" "RTN","SDHLAPT2",54,0) S $P(ST12,"^",4)=$G(ST1) "RTN","SDHLAPT2",55,0) S $P(SDTMPHL(1),"|",12)=$G(ST12) "RTN","SDHLAPT2",56,0) S $P(SDTMPHL(5),"|",5)=$P(ST12,"^",4) "RTN","SDHLAPT2",57,0) Q "RTN","SDHLAPT2",58,0) ; "RTN","SDHLAPT2",59,0) TMCONV(X) ; "RTN","SDHLAPT2",60,0) ;convert time to Zulu timezone "RTN","SDHLAPT2",61,0) N TZONE,DIFF,UTC,UTC1,UTC2 "RTN","SDHLAPT2",62,0) S TZONE=$$GET1^DIQ(4.3,"1,",1,"I"),DIFF=$$GET1^DIQ(4.4,$G(TZONE)_",",2,"E")*(-1) "RTN","SDHLAPT2",63,0) S UTC=$$FMADD^XLFDT(X,,$G(DIFF),,),UTC2=$$FMTHL7^XLFDT(UTC) "RTN","SDHLAPT2",64,0) S UTC1=$E(UTC2,1,4)_"-"_$E(UTC2,5,6)_"-"_$E(UTC2,7,8)_"T"_$E(UTC2,9,10)_":"_$E(UTC2,11,12)_":00.000Z" "RTN","SDHLAPT2",65,0) Q UTC1 "RTN","SDHLAPT2",66,0) ; "RTN","SDHLAPT2",67,0) CHKCON(DFN,SDAPTYP) ; checks if both consult ids or both rtc ids match the patient, if the consult or rts is not for the patient, reject "RTN","SDHLAPT2",68,0) Q:$G(AIL(1,3,1,4))'=$G(AIL(2,3,1,4)) "RTN","SDHLAPT2",69,0) S STOPME=0 "RTN","SDHLAPT2",70,0) N IENS,X1,GMRDFN "RTN","SDHLAPT2",71,0) I $P($G(SDAPTYP),"|",1)="C" D "RTN","SDHLAPT2",72,0) .F X1=1:1:2 D "RTN","SDHLAPT2",73,0) ..Q:$G(STOPME)=1 "RTN","SDHLAPT2",74,0) ..S IENS=+$G(AIL(X1,4,1,1)) "RTN","SDHLAPT2",75,0) ..Q:+$G(IENS)'>0 "RTN","SDHLAPT2",76,0) ..S GMRDFN=$$GET1^DIQ(123,IENS_",",.02,"I","ERR") "RTN","SDHLAPT2",77,0) ..I $G(GMRDFN)'=$G(DFN)!($G(^GMR(123,+$G(IENS),0))="") D "RTN","SDHLAPT2",78,0) ...S ERR="MSA^1^^100^AE^CONSULT ID# "_+$G(IENS)_" IS NOT FOR PATIENT "_$P(^DPT(DFN,0),"^") "RTN","SDHLAPT2",79,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHLAPT2",80,0) ...S STOPME=1 "RTN","SDHLAPT2",81,0) ..Q "RTN","SDHLAPT2",82,0) .Q "RTN","SDHLAPT2",83,0) I $P($G(SDAPTYP),"|",1)="R" D "RTN","SDHLAPT2",84,0) .F X1=1:1:2 D "RTN","SDHLAPT2",85,0) ..Q:$G(STOPME)=1 "RTN","SDHLAPT2",86,0) ..S IENS=+$G(AIL(X1,4,1,1)) "RTN","SDHLAPT2",87,0) ..Q:+$G(IENS)'>0 "RTN","SDHLAPT2",88,0) ..I $G(DFN)'=$P($G(^SDEC(409.85,IENS,0)),"^",1)!($G(^SDEC(409.85,IENS,0))="") D "RTN","SDHLAPT2",89,0) ...S STOPME=1 "RTN","SDHLAPT2",90,0) ...S ERR="MSA^1^^100^AE^RTC ORDER# "_+$P($G(SDAPTYP),"|",2)_" IS NOT FOR PATIENT "_$P(^DPT(DFN,0),"^") "RTN","SDHLAPT2",91,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHLAPT2",92,0) ..Q "RTN","SDHLAPT2",93,0) Q "RTN","SDHLAPT2",94,0) CHKCAN(PAT,CLINIC,DATE) ; check to see if the appointment in 44 is canceled correctly. if not cancel it "RTN","SDHLAPT2",95,0) N TIEN,DIK,DA "RTN","SDHLAPT2",96,0) Q:$G(PAT)'>0 "RTN","SDHLAPT2",97,0) Q:$G(CLINIC)'>0 "RTN","SDHLAPT2",98,0) Q:$G(DATE)="" "RTN","SDHLAPT2",99,0) S TIEN=$$SCIEN^SDECU2(PAT,CLINIC,DATE) "RTN","SDHLAPT2",100,0) Q:$G(TIEN)'>0 "RTN","SDHLAPT2",101,0) I $G(TIEN)>0 D "RTN","SDHLAPT2",102,0) .S DIK="^SC("_CLINIC_",""S"","_DATE_",1," "RTN","SDHLAPT2",103,0) .S DA(2)=CLINIC,DA(1)=DATE,DA=TIEN "RTN","SDHLAPT2",104,0) .D ^DIK "RTN","SDHLAPT2",105,0) .K DIK,DA "RTN","SDHLAPT2",106,0) Q "RTN","SDM1A") 0^7^B133660852^B131891737 "RTN","SDM1A",1,0) SDM1A ;SF/GFT,ALB/TMP,MS/PB - MAKE APPOINTMENT ;JUN 21, 2017 "RTN","SDM1A",2,0) ;;5.3;Scheduling;**26,94,155,206,168,223,241,263,327,478,446,544,621,622,627,658,665,650,704**;Aug 13, 1993;Build 64 "RTN","SDM1A",3,0) ; "RTN","SDM1A",4,0) OK I $D(SDMLT) D ^SDM4 Q:X="^"!(SDMADE=2) "RTN","SDM1A",5,0) S ^SC(SC,"ST",$P(SD,"."),1)=S,^DPT(DFN,"S",SD,0)=SC,^SC(SC,"S",SD,0)=SD S:'$D(^DPT(DFN,"S",0)) ^(0)="^2.98P^^" S:'$D(^SC(SC,"S",0)) ^(0)="^44.001DA^^" L "RTN","SDM1A",6,0) S1 L +^SC(SC,"S",SD,1):$G(DILOCKTM,5) W:'$T "Another user is editing this record. Trying again.",! G:'$T S1 F SDY=1:1 I '$D(^SC(SC,"S",SD,1,SDY)) S:'$D(^(0)) ^(0)="^44.003PA^^" S ^(SDY,0)=DFN_U_(+SL)_"^^^^"_$G(DUZ)_U_DT L -^SC(SC,"S",SD,1) Q "RTN","SDM1A",7,0) I SM S ^("OB")="O" ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,"OB") "RTN","SDM1A",8,0) I $D(^SC(SC,"RAD")),^("RAD")="Y"!(^("RAD")=1) S ^SC("ARAD",SC,SD,DFN)="" "RTN","SDM1A",9,0) S SDINP=$$INP^SDAM2(DFN,SD) "RTN","SDM1A",10,0) ;-- added sub-category "RTN","SDM1A",11,0) S COV=3,SDYC="",COV=$S(COLLAT=1:1,1:3),SDYC=$S(COLLAT=7:1,1:"") "RTN","SDM1A",12,0) S:SD
DT,$D(^DPT(DFN,.321)) D EN1^SDM3 "RTN","SDM1A",28,0) ;Wait List SD*5.3*263 "RTN","SDM1A",29,0) ;I '$D(SDWLLIST) D ^SDWLR ;replaced with sd/372, see below "RTN","SDM1A",30,0) EWLCHK ;check if patient has any open EWL entries (SD/372) "RTN","SDM1A",31,0) ;get appointment "RTN","SDM1A",32,0) K ^TMP($J,"SDAMA301"),^TMP($J,"APPT") "RTN","SDM1A",33,0) D APPT^SDWLEVAL(DFN,SD,SC) "RTN","SDM1A",34,0) Q:'$D(^TMP($J,"APPT")) "RTN","SDM1A",35,0) N SDWL,SDWLF,SDWLIST S SDWL="" S SDWLF=0 ;alb/sat 627 "RTN","SDM1A",36,0) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D "RTN","SDM1A",37,0) .K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL") "RTN","SDM1A",38,0) .D INIT^SDWLPL(DFN,"M") "RTN","SDM1A",39,0) .Q:'$D(^TMP($J,"SDWLPL")) "RTN","SDM1A",40,0) .D LIST^SDWLPL("M",DFN) "RTN","SDM1A",41,0) .D SDGET(.SDWLIST) ;alb/sat 627 "RTN","SDM1A",42,0) .F Q:'$D(^TMP($J,"SDWLPL")) N SDR D ANSW^SDWLEVAL(1,.SDR) S:SDR SDWLF=1 I 'SDR D LIST^SDWLPL("M",DFN) D "RTN","SDM1A",43,0) ..F N SDR D ANSW^SDWLEVAL(0,.SDR) Q:'$D(^TMP($J,"SDWLPL")) I 'SDR W !,"MUST ENTER A REASON NOT TO DISPOSITION MATCHED EWL ENTRY",! ;alb/sat665 remove S SDWLF=1 "RTN","SDM1A",44,0) .S:+SDWLF SDWL=$$SDWL(.SDWLIST) ;alb/sat 627 "RTN","SDM1A",45,0) ;update SDEC APPOINTMENT file 409.84 ;alb/sat 627 "RTN","SDM1A",46,0) N SDECAR,SDREC,SDRES "RTN","SDM1A",47,0) S SDREC="" "RTN","SDM1A",48,0) I $G(CNSLTLNK)="",SDWL="" S SDREC=$$RECALL^SDECUTL(DFN,SD,SDSC) ;check if recall appt "RTN","SDM1A",49,0) I SDWL="",$G(CNSLTLNK)="",SDREC="" S SDECAR=$$SDWLA(DFN,SD,SDSC,SDDATE,$G(SDAPTYP),$G(SDECANS)) ;alb/sat 665 add SDECANS "RTN","SDM1A",50,0) K SDECANS "RTN","SDM1A",51,0) S SDRES=$$GETRES^SDECUTL(SC) "RTN","SDM1A",52,0) S SDAPTYP=$G(SDAPTYP) S:SDAPTYP="" SDAPTYP=$$GET1^DIQ(44,SC_",",2507,"I") "RTN","SDM1A",53,0) ;alb/sat 658 - moved below OTHER INFO prompt to store in NOTE field of 409.84 "RTN","SDM1A",54,0) ;D SDECADD^SDEC07(SD,$$FMADD^XLFDT(SD,,,+SL),DFN,SDRES,0,SDDATE,"",$S(+SDWL:"E|"_SDWL,+$G(CNSLTLNK):"C|"_CNSLTLNK,+SDREC:"R|"_SDREC,+SDECAR:"A|"_SDECAR,1:""),,SC,,,,SDAPTYP) ;ADD SDEC APPOINTMENT ENTRY "RTN","SDM1A",55,0) ;end addition/modification ;alb/sat 627 "RTN","SDM1A",56,0) ;CREATE 120 FLAG IF APPLICABLE; appt created "RTN","SDM1A",57,0) FLG N SDST S SDST=$G(^TMP($J,"APPT",1)) I +SDST>0 D "RTN","SDM1A",58,0) .Q ; sd/446 "RTN","SDM1A",59,0) .N SDT,SDDES,SDPAR,SDDES1,SDT1 S SDPAR=0 S SDT=+SDST,SDDES=$P(SDST,U,17) I SDDES="" S SDDES=DT ; today's date if no desired date "RTN","SDM1A",60,0) .S X=SDT D H^%DTC S SDT1=%H "RTN","SDM1A",61,0) .S X=SDDES D H^%DTC S SDDES1=%H "RTN","SDM1A",62,0) .I SDT1-SDDES1>120 N SD120,SD120A S SD120=1,SD120A=1 D "RTN","SDM1A",63,0) ..; CREATE ewl eN SDPR S SDPR=$S(SDDES=DT:"A",1:"F") entry with 120 flag "RTN","SDM1A",64,0) ..N SDPR S SDPR=$S(SDDES=DT:"A",1:"F") ;10 "RTN","SDM1A",65,0) ..N SDWLIN S SDWLIN=+$P(SDST,U,15) ;2 "RTN","SDM1A",66,0) ..N SDWLSCPR S SDWLSCPR=0 I +$P(SDST,U,10)=11 S SDWLSCPR=1 ;15 "RTN","SDM1A",67,0) ..N SC,SDWLSCL S SC=+$P(SDST,U,2) D "RTN","SDM1A",68,0) ...I $D(^SDWL(409.32,"B",SC)) S SDWLSCL=$O(^SDWL(409.32,"B",SC,"")) Q ;8 "RTN","SDM1A",69,0) ...;create 409.32 entry "RTN","SDM1A",70,0) ...N DA,DIC S DIC(0)="LX",X=SC,DIC="^SDWL(409.32," D FILE^DICN "RTN","SDM1A",71,0) ...S SDWLSCL=DA "RTN","SDM1A",72,0) ...S DIE="^SDWL(409.32," "RTN","SDM1A",73,0) ...S DR=".02////^S X=SDWLIN" D ^DIE "RTN","SDM1A",74,0) ...S DR="1////^S X=DT" "RTN","SDM1A",75,0) ...S DR=DR_";2////^S X=DUZ" "RTN","SDM1A",76,0) ...D ^DIE S SDPAR=1 "RTN","SDM1A",77,0) ..N DA S DIC(0)="LX",(X,SDWLDFN)=+$P(SDST,U,4),X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN "RTN","SDM1A",78,0) ..F L +^SDWL(409.3,DA):$G(DILOCKTM,5) Q:$T D "RTN","SDM1A",79,0) ...I '$T W !,"Unable to acquire a lock on the Wait List file" Q "RTN","SDM1A",80,0) ..; Update EWL variables. "RTN","SDM1A",81,0) ..S SDWLDA=DA D EN^SDWLE11 ; get enrollee both SDWLDA and SDWLDFN have to be "RTN","SDM1A",82,0) ..N SDWLCM S SDWLCM=" > 120 days; appt created" "RTN","SDM1A",83,0) ..N SDWLSCPG S SDWLSCPG=$S($P($G(^DPT(SDWLDFN,.3)),U,1)="Y":$P(^(.3),U,2),1:"") "RTN","SDM1A",84,0) ..S DR="1////^S X=DT" "RTN","SDM1A",85,0) ..S DR=DR_";2////^S X=SDWLIN" "RTN","SDM1A",86,0) ..S DR=DR_";4////^S X=4" "RTN","SDM1A",87,0) ..S DR=DR_";8////^S X=SDWLSCL" "RTN","SDM1A",88,0) ..S DR=DR_";9////^S X=DUZ" "RTN","SDM1A",89,0) ..S DR=DR_";10////^S X=SDPR" "RTN","SDM1A",90,0) ..S DR=DR_";11////^S X=2" ; by patient for this entry to avoid asking for provider "RTN","SDM1A",91,0) ..S DR=DR_";14////^S X=SDWLSCPG" "RTN","SDM1A",92,0) ..S DR=DR_";15////^S X=SDWLSCPR" "RTN","SDM1A",93,0) ..S DR=DR_";22////^S X=SDDES" "RTN","SDM1A",94,0) ..S DR=DR_";23////^S X=""O""" "RTN","SDM1A",95,0) ..S DR=DR_";25////^S X=SDWLCM" "RTN","SDM1A",96,0) ..S DR=DR_";36////^S X=SD120" "RTN","SDM1A",97,0) ..S DR=DR_";39////^S X=SD120A" "RTN","SDM1A",98,0) ..S DIE="^SDWL(409.3," "RTN","SDM1A",99,0) ..D ^DIE "RTN","SDM1A",100,0) ..L -^SDWL(409.3,DA) "RTN","SDM1A",101,0) ..D MESS^SDWL120(SDWLDFN,SC,SDT,SDPAR) "RTN","SDM1A",102,0) ;continue appointment entry process "RTN","SDM1A",103,0) ORD S %=2 W !,"WANT PATIENT NOTIFIED OF LAB,X-RAY, OR EKG STOPS" D YN^DICN I '% W !," Enter YES to notify patient on appt. letter of LAB, X-RAY, or EKG stops" G ORD "RTN","SDM1A",104,0) I '(%-1) D ORDY^SDM3 "RTN","SDM1A",105,0) OTHER R !," OTHER INFO: ",D:DTIME I D["^" W !,*7,"'^' not allowed - hit return if no 'OTHER INFO' is to be entered" G OTHER "RTN","SDM1A",106,0) S TMPD=D I $L(D)>150 D MSG^SDMM G OTHER ;SD/478 "RTN","SDM1A",107,0) I D]"",D?."?"!(D'?.ANP) W " ENTER LAB, SCAN, ETC." G OTHER "RTN","SDM1A",108,0) I $L($G(^SC(SC,"S",SD,1,SDY,0)))+$L(D)+$L(DT)+$S($D(DUZ):$L(DUZ),1:0)>250 D MSG^SDMM G OTHER ; sd/446 "RTN","SDM1A",109,0) ;S $P(^(0),"^",4)=D,$P(^(0),U,6,7)=$S($D(DUZ):DUZ,1:"")_U_DT ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,0) "RTN","SDM1A",110,0) S $P(^(0),"^",4)=D ;NAKED REFERENCE - ^SC(IFN,"S",Date,1,SDY,0) 544 moved DUZ&DT to tag S1. "RTN","SDM1A",111,0) S:$G(SL)="" SL=$G(^SC(+SC,"SL")) ;alb/sat 658 - SL gets killed in SDM3 if 'WANT PATIENT NOTIFIED OF LAB,X-RAY, OR EKG STOPS' is answered with Y "RTN","SDM1A",112,0) D SDECADD^SDEC07(SD,$$FMADD^XLFDT(SD,,,+SL),DFN,SDRES,0,SDDATE,"",$S(+SDWL:"E|"_SDWL,+$G(CNSLTLNK):"C|"_CNSLTLNK,+SDREC:"R|"_SDREC,+SDECAR:"A|"_SDECAR,1:""),,SC,$G(D),,,SDAPTYP) ;ADD SDEC APPOINTMENT ENTRY ;alb/sat 658 moved from above "RTN","SDM1A",113,0) D:$D(TMP) LINK^SDCNSLT(SC,SDY,SD,CNSLTLNK) ;SD/478 "RTN","SDM1A",114,0) D:$D(TMP) EDITCS^SDCNSLT(SD,TMPD,TMPYCLNC,CNSLTLNK) ;SD/478 "RTN","SDM1A",115,0) K TMP ;SD/478 "RTN","SDM1A",116,0) XR I $S('$D(^SC(SC,"RAD")):1,^("RAD")="Y":0,^("RAD")=1:0,1:1) S %=2 W !,"WANT PREVIOUS X-RAY RESULTS SENT TO CLINIC" D YN^DICN G:'% HXR I '(%-1) S ^SC("ARAD",SC,SD,DFN)="" "RTN","SDM1A",117,0) SDMM S SDEMP=0 I COLLAT=7 S:SDEC'=SDCOL SDEMP=SDCOL G OV "RTN","SDM1A",118,0) D ELIG^VADPT I $O(VAEL(1,0))>0 D ELIG^SDM4:"369"[SDAPTYP S SDEMP=$S(SDDECOD:SDDECOD,1:SDEMP) "RTN","SDM1A",119,0) OV Q:$D(SDZM) K SDQ1,SDEC,SDCOL I +SDEMP S $P(^SC(SC,"S",SD,1,SDY,0),"^",10)=+SDEMP "RTN","SDM1A",120,0) S SDMADE=1 D EVT "RTN","SDM1A",121,0) LET ; SD*5.3*622 - help user print the PRE-APPT letter for a patient "RTN","SDM1A",122,0) ; check for a PRE-APPT letter defined and if none, don't issue a device prompt "RTN","SDM1A",123,0) N SDFN ; new SDFN to see the patient prompt next time "RTN","SDM1A",124,0) S %=2 W !!,"WANT TO PRINT THE PRE-APPOINTMENT LETTER" D YN^DICN I %=0 W !,"RESPOND YES (Y) OR NO (N)" G:'% LET "RTN","SDM1A",125,0) I (%=2)!(%=-1) Q "RTN","SDM1A",126,0) I $P($G(^SC(SC,"LTR")),U,2)="" D Q "RTN","SDM1A",127,0) . W $C(7),!!,"PATIENT "_$P(^DPT(DFN,0),U,1)," ",$P(^(0),U,9)," HAS FUTURE APPTS., but" "RTN","SDM1A",128,0) . W !,$P(^SC(SC,0),U,1)_" is not assigned a PRE-APPOINTMENT LETTER",! "RTN","SDM1A",129,0) . S DIR(0)="E" D ^DIR K DIR "RTN","SDM1A",130,0) ; "RTN","SDM1A",131,0) ; pre-define letter type (P), the division, date for appt, etc. "RTN","SDM1A",132,0) S (SDBD,SDED)=SDTTM,L0="P",SD9=0,VAUTNALL=1,VAUTNI=2,S1="P",SDLT=1,SDV1=1,SDFORM="" "RTN","SDM1A",133,0) S L2=$S(L0="P":"^SDL1",1:"^SDL1"),J=SDBD "RTN","SDM1A",134,0) S (A,SDFN,S)=DFN,L="^SDL1",SDCL=+$P(^SC(SC,0),U,1),SDC=SC,SDX=SDTTM "RTN","SDM1A",135,0) S SDLET=$P(^SC(SC,"LTR"),U,2) ; letter IEN "RTN","SDM1A",136,0) S SDLET1=SDLET "RTN","SDM1A",137,0) I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY "RTN","SDM1A",138,0) I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY "RTN","SDM1A",139,0) ; prepare to queue the letter if the user so desires "RTN","SDM1A",140,0) N %ZIS,POP,ZTDESC,ZTRTN,ZTSAVE "RTN","SDM1A",141,0) S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS Q:POP "RTN","SDM1A",142,0) I $D(IO("Q")) S ZTRTN="QUE^SDM1A",ZTDESC="PRINT PRE-APPT LETTER",ZTSAVE("*")="" D ^%ZTLOAD,HOME^%ZIS K IO("Q") Q "RTN","SDM1A",143,0) D QUE ; print right away without getting into the queue "RTN","SDM1A",144,0) D HOME^%ZIS "RTN","SDM1A",145,0) Q "RTN","SDM1A",146,0) ; "RTN","SDM1A",147,0) QUE ; execute whether by queue or immediate print request "RTN","SDM1A",148,0) U IO "RTN","SDM1A",149,0) N SDFIRST S SDFIRST=1 ; Flag to determine first page SD*650 "RTN","SDM1A",150,0) D PRT^SDLT,WRAPP^SDLT "RTN","SDM1A",151,0) ; if there are x-ray, lab, or ekg appts, print them too "RTN","SDM1A",152,0) S SDATA=$G(^DPT(DFN,"S",SDX,0)) "RTN","SDM1A",153,0) I $D(SDATA) F B=3,4,5 D "RTN","SDM1A",154,0) . S SDCL=$S(B=3:"LAB",B=4:"XRAY",1:"EKG") "RTN","SDM1A",155,0) . S SDX=$P($G(SDATA),U,B) "RTN","SDM1A",156,0) . S SC=SDCL Q:$G(SDX)="" D FORM^SDLT "RTN","SDM1A",157,0) ; "RTN","SDM1A",158,0) D REST^SDLT "RTN","SDM1A",159,0) D ^%ZISC "RTN","SDM1A",160,0) Q ; SD*5.3*622 - end of changes "RTN","SDM1A",161,0) ; "RTN","SDM1A",162,0) HXR W !," Enter YES to have previous XRAY results sent to the clinic" G XR "RTN","SDM1A",163,0) Q "RTN","SDM1A",164,0) CS S SDCS=+$P(^SC(+SC,0),"^",7) I $S('$D(^DIC(40.7,SDCS,0)):1,'$P(^(0),"^",3):0,1:$P(^(0),"^",3)'>DT) W !!,*7,"** WARNING - CLINIC HAS AN INVALID OR INACTIVE STOP CODE!!!",!! "RTN","SDM1A",165,0) S SDCS=+$P(^SC(+SC,0),"^",18) I $S('SDCS:0,'$D(^DIC(40.7,SDCS,0)):1,'$P(^(0),"^",3):0,1:$P(^(0),"^",3)'>DT) W !!,*7,"** WARNING - CLINIC HAS AN INVALID OR INACTIVE CREDIT STOP CODE!!!",!! "RTN","SDM1A",166,0) K SDCS Q "RTN","SDM1A",167,0) STATUS(SDCL,SDINP,SDT) ; -- determine status for NEW appts "RTN","SDM1A",168,0) Q $S(SDINP]"":SDINP,$$CHK(.SDCL,.SDT):"NT",1:"") "RTN","SDM1A",169,0) CHK(SDCL,SDT) ; -- should appt be NT'ed "RTN","SDM1A",170,0) ; -- non-count clinic check := don't NT appt "RTN","SDM1A",171,0) ; -- appt update executed := need to NT appt "RTN","SDM1A",172,0) ; -- otherwise := don't NT appt "RTN","SDM1A",173,0) Q $S($P($G(^SC(SDCL,0)),U,17)="Y":0,$D(^SDD(409.65,"AUPD",$P(SDT,"."))):1,1:0) "RTN","SDM1A",174,0) EVT ; -- separate tag if need to NEW vars "RTN","SDM1A",175,0) D MAKE^SDAMEVT(DFN,SD,SC,SDY,0) "RTN","SDM1A",176,0) Q "RTN","SDM1A",177,0) REQ(SDT) ; -- which is required check in(CI) or out(CO) "RTN","SDM1A",178,0) Q $S($$REQDT()>SDT:"CI",1:"CO") "RTN","SDM1A",179,0) REQDT() ; -- co required date "RTN","SDM1A",180,0) Q $S($P(^DG(43,1,"SCLR"),U,23):$P(^("SCLR"),U,23),1:2931001) "RTN","SDM1A",181,0) COCMP(DFN,SDT) ; -- date CO completed "RTN","SDM1A",182,0) Q $P($G(^SCE(+$P($G(^DPT(DFN,"S",SDT,0)),U,20),0)),U,7) "RTN","SDM1A",183,0) CI(SDCL,SDT,SDDA,SDACT) ; -- ok to update DPT "RTN","SDM1A",184,0) N C "RTN","SDM1A",185,0) I '$$CHK(.SDCL,.SDT) G CIQ "RTN","SDM1A",186,0) I $$REQ(SDT)'="CI" G CIQ "RTN","SDM1A",187,0) I SDACT="SET",$D(^DPT(+^SC(SDCL,"S",SDT,1,SDDA,0),"S",SDT,0)),$P(^(0),U,2)="NT" S $P(^(0),U,2)="" "RTN","SDM1A",188,0) I SDACT="KILL" S C=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")) I $D(^DPT(+$G(^(0)),"S",SDT,0)),$P(^(0),U,2)="",'$P(C,U,3) S $P(^(0),U,2)="NT" "RTN","SDM1A",189,0) CIQ Q "RTN","SDM1A",190,0) CO(SDCL,SDT,SDDA,SDACT) ; -- ok to update DPT "RTN","SDM1A",191,0) N DFN,C "RTN","SDM1A",192,0) I '$$CHK(.SDCL,.SDT) G COQ "RTN","SDM1A",193,0) I $$REQ(.SDT)'="CO" D G COQ "RTN","SDM1A",194,0) .I SDACT="SET",$D(^DPT(+^SC(SDCL,"S",SDT,1,SDDA,0),"S",SDT,0)),$P(^(0),U,2)="NT" S $P(^(0),U,2)="" "RTN","SDM1A",195,0) .I SDACT="KILL" S C=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")) I $D(^DPT(+$G(^(0)),"S",SDT,0)),$P(^(0),U,2)="",'C S $P(^(0),U,2)="NT" "RTN","SDM1A",196,0) S DFN=+^SC(SDCL,"S",SDT,1,SDDA,0) "RTN","SDM1A",197,0) D UPD(.DFN,.SDT,$$COCMP(.DFN,.SDT),$S(SDACT="SET":X,1:"")) "RTN","SDM1A",198,0) COQ Q "RTN","SDM1A",199,0) UPD(DFN,SDT,SDCOCMP,SDCODT) ; -- update status "RTN","SDM1A",200,0) N Y "RTN","SDM1A",201,0) I $D(^DPT(DFN,"S",SDT,0)) S Y=$P(^(0),U,2) D "RTN","SDM1A",202,0) .I 'SDCOCMP!('SDCODT) S:Y="" $P(^DPT(DFN,"S",SDT,0),U,2)="NT" Q "RTN","SDM1A",203,0) .S:Y="NT" $P(^DPT(DFN,"S",SDT,0),U,2)="" "RTN","SDM1A",204,0) Q "RTN","SDM1A",205,0) OE(SDOE,SDACT) ; -- called by x-ref on co completed field(#.07) in ^SCE "RTN","SDM1A",206,0) N Y S Y=^SCE(SDOE,0) "RTN","SDM1A",207,0) I $P(Y,U,8)'=1 G OEQ "RTN","SDM1A",208,0) I $$REQ(+Y)'="CO" G OEQ "RTN","SDM1A",209,0) I '$$CANT(+$P(Y,U,2),+Y,SDOE),'$$CHK(+$P(Y,U,4),+Y) G OEQ "RTN","SDM1A",210,0) D UPD(+$P(Y,U,2),+Y,$S(SDACT="SET":X,1:""),$P($G(^SC(+$P(Y,U,4),"S",+Y,1,+$P(Y,U,9),"C")),U,3)) "RTN","SDM1A",211,0) OEQ Q "RTN","SDM1A",212,0) CONF(SDSRTY,SDSRFU,DFN,SDT,SC) ;Confirm scheduling request type "RTN","SDM1A",213,0) ;Input: SDSRTY=request type "RTN","SDM1A",214,0) ;Input: SDSRFU=follow-up indicator "RTN","SDM1A",215,0) ;Input: DFN=patient ien "RTN","SDM1A",216,0) ;Input: SDT=appointment date/time "RTN","SDM1A",217,0) ;Input: SC=clinic ifn "RTN","SDM1A",218,0) N DIR,DIE,DA,DR,SDX,SDY,X,Y "RTN","SDM1A",219,0) S DIR(0)="Y",DIR("B")="YES" "RTN","SDM1A",220,0) S DIR("A")="THIS APPOINTMENT IS MARKED AS '"_SDSRTY(0)_"', IS THIS CORRECT" "RTN","SDM1A",221,0) W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","SDM1A",222,0) I 'Y S SDX='SDSRTY,SDX(0)=$$TXRT(.SDX) W !!,"THIS APPOINTMENT HAS NOW BEEN MARKED AS '"_$S('SDSRTY:"",1:"NOT ")_"NEXT AVAILABLE'." "RTN","SDM1A",223,0) ;S DIR("A")="THIS APPOINTMENT IS DEFINED AS '"_$S(SDSRFU:"FOLLOW-UP",1:"OTHER THAN FOLLOW-UP")_"', OK" "RTN","SDM1A",224,0) ;W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","SDM1A",225,0) ;I 'Y S SDY='SDSRFU W " (changed)" "RTN","SDM1A",226,0) Q:'$D(SDX) S DR="" "RTN","SDM1A",227,0) I $D(SDX) S DR="25///^S X=$P(SDX,U,2);26///^S X=$$NAVA^SDMANA(SC,SDT,$P(SDX,U,2))" "RTN","SDM1A",228,0) ;I $D(SDY) S:$L(DR) DR=DR_";" S DR=DR_"26///^S X=SDY" "RTN","SDM1A",229,0) S DA=SDT,DA(1)=DFN "RTN","SDM1A",230,0) S DIE="^DPT(DA(1),""S""," D ^DIE "RTN","SDM1A",231,0) Q "RTN","SDM1A",232,0) TXRT(SDSRTY) ;Transform request type "RTN","SDM1A",233,0) ;Input: SDSRTY=variable to return request type (pass by reference) "RTN","SDM1A",234,0) ;Output: external text for SDSRTY(0) "RTN","SDM1A",235,0) I SDSRTY S SDSRTY=SDSRTY_U_"N" Q "NEXT AVAILABLE" "RTN","SDM1A",236,0) S SDSRTY=SDSRTY_U_"O" Q "NOT NEXT AVAILABLE" "RTN","SDM1A",237,0) CANT(DFN,SDT,SDOE) ;Determine if clinic appt. has been marked "NT" "RTN","SDM1A",238,0) ;Output: '1' if appt. points to encounter and is marked "NT", otherwise '0' "RTN","SDM1A",239,0) N SDAPP S SDAPP=$G(^DPT(DFN,"S",SDT,0)) "RTN","SDM1A",240,0) Q:$P(SDAPP,U,20)'=SDOE 0 "RTN","SDM1A",241,0) Q $P(SDAPP,U,2)="NT" "RTN","SDM1A",242,0) SDGET(SDWLIST) ;build array of wait list entries that are in ^TMP($J,"SDWLPL") "RTN","SDM1A",243,0) N SDI "RTN","SDM1A",244,0) K SDWLIST "RTN","SDM1A",245,0) S SDI="" F S SDI=$O(^TMP($J,"SDWLPL",SDI)) Q:SDI="" D "RTN","SDM1A",246,0) .S SDWLIST(+$G(^TMP($J,"SDWLPL",SDI)))="" "RTN","SDM1A",247,0) Q "RTN","SDM1A",248,0) ; -- Variable doc for above tags "RTN","SDM1A",249,0) ; SDCL := file 44 ien "RTN","SDM1A",250,0) ; SDT := appt date/time "RTN","SDM1A",251,0) ; DFN := file 2 ien "RTN","SDM1A",252,0) ; SDDA := ^SC(SDCL,"S",SDT,1,SDDA,0) "RTN","SDM1A",253,0) ; SDACT := current x-ref action 'set' or 'kill' "RTN","SDM1A",254,0) ; SDCOCMP := check out completed date "RTN","SDM1A",255,0) ; SDCODT := check out date/time "RTN","SDM1A",256,0) ; SDOE := Outpatient Encounter ien "RTN","SDM1A",257,0) ; SDINP := inpatient status ('I' or null) "RTN","SDM1A",258,0) ; SDINP := inpatient status ('I' or null) "RTN","SDM1A",259,0) ; "RTN","SDM1A",260,0) SDWL(SDWLIST) ;determine EWL that was closed for this appointment ;alb/sat SD/627 "RTN","SDM1A",261,0) N SDI "RTN","SDM1A",262,0) S SDI="" F S SDI=$O(^TMP($J,"SDWLPL",SDI)) Q:SDI="" D "RTN","SDM1A",263,0) .I $D(SDWLIST(+$G(^TMP($J,"SDWLPL",SDI)))) K SDWLIST(+$G(^TMP($J,"SDWLPL",SDI))) "RTN","SDM1A",264,0) Q $O(SDWLIST(0)) "RTN","SDM1A",265,0) SDWLA(DFN,SD,SDSC,SDDATE,SDAPTYP,SDECANS) ;add SDEC APPT REQUEST entry ;alb/sat SD/627 ;alb/sat 665 add SDECANS "RTN","SDM1A",266,0) ;INPUT: "RTN","SDM1A",267,0) ; DFN "RTN","SDM1A",268,0) ; SD = appointment date/time in fm format "RTN","SDM1A",269,0) ; SDSC = clinic code pointer to HOSPITAL LOCATION file "RTN","SDM1A",270,0) ; SDDATE = desired date of appointment "RTN","SDM1A",271,0) ; SDAPTYP = pointer to APPOINTMENT TYPE file 409.1 "RTN","SDM1A",272,0) ; SDECANS = service connected condition Y=yes N=no from SDM4 ;alb/sat 665 "RTN","SDM1A",273,0) N SDECINP,SDWLSTAT,SDARIEN,SDWLRET,X "RTN","SDM1A",274,0) S SDAPTYP=$G(SDAPTYP) "RTN","SDM1A",275,0) S SDECANS=$G(SDECANS) ;alb/sat 665 "RTN","SDM1A",276,0) ;get clinic location name "RTN","SDM1A",277,0) K ^TMP("SDEC50",$J,"PCSTGET") "RTN","SDM1A",278,0) D PCSTGET^SDEC(.SDWLRET,DFN,SDSC) "RTN","SDM1A",279,0) S SDWLSTAT=$P($P($G(^TMP("SDEC50",$J,"PCSTGET",1)),$C(30),1),U,2) "RTN","SDM1A",280,0) K ^TMP("SDEC50",$J,"PCSTGET") "RTN","SDM1A",281,0) ;set appt request entry "RTN","SDM1A",282,0) S SDECINP(1)="" "RTN","SDM1A",283,0) S SDECINP(2)=DFN ;patient "RTN","SDM1A",284,0) S SDECINP(3)=$E($$NOW^XLFDT,1,12) ;originating date/time "RTN","SDM1A",285,0) S SDECINP(4)=DUZ(2) ;institution "RTN","SDM1A",286,0) S SDECINP(5)="APPOINTMENT" ;wait list type - specific clinic "RTN","SDM1A",287,0) S SDECINP(6)=SDSC ;clinic "RTN","SDM1A",288,0) S SDECINP(7)=DUZ ;originating user "RTN","SDM1A",289,0) S SDECINP(8)="ASAP" ;priority "RTN","SDM1A",290,0) S SDECINP(9)="PATIENT" ;requested by "RTN","SDM1A",291,0) S SDECINP(11)=SDDATE ;desired date of appointment "RTN","SDM1A",292,0) ;S SDECINP(16)=$S(SDWLSTAT="YES":"ESTABLISHED",1:"NEW") "RTN","SDM1A",293,0) S SDECINP(14)="NO" ;multiple appointment RTC "RTN","SDM1A",294,0) S SDECINP(15)=0 "RTN","SDM1A",295,0) S SDECINP(16)=0 "RTN","SDM1A",296,0) S:SDECANS'="" SDECINP(18)=$S(SDECANS="Y":"YES",1:0) ;alb/sat 665 "RTN","SDM1A",297,0) S:+SDAPTYP SDECINP(22)=+SDAPTYP ;appointment type "RTN","SDM1A",298,0) K SDWLRET "RTN","SDM1A",299,0) S SDWLRET="" "RTN","SDM1A",300,0) D ARSET1^SDEC(.SDWLRET,.SDECINP) "RTN","SDM1A",301,0) S SDARIEN=$P($P(SDWLRET,$C(30),2),U,1) "RTN","SDM1A",302,0) S SDWLRET="" "RTN","SDM1A",303,0) Q:'$D(^SDEC(409.85,+SDARIEN,0)) "" "RTN","SDM1A",304,0) ;close appt request entry "RTN","SDM1A",305,0) K INP "RTN","SDM1A",306,0) S INP(1)=SDARIEN "RTN","SDM1A",307,0) S INP(2)="REMOVED/SCHEDULED-ASSIGNED" "RTN","SDM1A",308,0) S INP(3)=DUZ "RTN","SDM1A",309,0) S INP(4)=$P(SD,".",1) "RTN","SDM1A",310,0) D ARCLOSE1^SDEC(.SDWLRET,.INP) "RTN","SDM1A",311,0) Q SDARIEN "RTN","SDTMBUS") 0^5^B30769228^n/a "RTN","SDTMBUS",1,0) SDTMBUS ;MS/TG/MS/PB - TMP HL7 Routine;JULY 05, 2018 "RTN","SDTMBUS",2,0) ;;5.3;Scheduling;**704**;May 29, 2018;Build 64 "RTN","SDTMBUS",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","SDTMBUS",4,0) ; "RTN","SDTMBUS",5,0) ; Segment builders common to multiple messages. "RTN","SDTMBUS",6,0) ; Message builders with message specific segments will contain "RTN","SDTMBUS",7,0) ; those message specific segment builders. Examples would be the "RTN","SDTMBUS",8,0) ; RDF for RTB^K13 messages or the PID for the ADR^A19. "RTN","SDTMBUS",9,0) ; "RTN","SDTMBUS",10,0) ; Integration Control Agreements "RTN","SDTMBUS",11,0) ; ICR 4837 reads to GMR(123 "RTN","SDTMBUS",12,0) ; DBIA 4557 reads to GMR(123.5 "RTN","SDTMBUS",13,0) Q "RTN","SDTMBUS",14,0) ; "RTN","SDTMBUS",15,0) MSA(MID,ERROR,HL) ;build MSA segment "RTN","SDTMBUS",16,0) N MSA,ACK "RTN","SDTMBUS",17,0) S ACK=$P(ERROR,"^",5) "RTN","SDTMBUS",18,0) I ACK="NF"!(ACK="") S ACK="AA" "RTN","SDTMBUS",19,0) S MSA(0)="MSA" "RTN","SDTMBUS",20,0) S MSA(1)=ACK ;ACK code "RTN","SDTMBUS",21,0) S MSA(2)=HL("MID") ;message control ID "RTN","SDTMBUS",22,0) S MSA(3)=$P(ERROR,"^",6) ;text message "RTN","SDTMBUS",23,0) Q $$BLDSEG^SDHL7UL(.MSA,.HL) "RTN","SDTMBUS",24,0) ; "RTN","SDTMBUS",25,0) ERR(ERROR,HL) ;build ERR segment "RTN","SDTMBUS",26,0) N ERR "RTN","SDTMBUS",27,0) S ERR(0)="ERR" "RTN","SDTMBUS",28,0) S ERR(1,1,1)=$P(ERROR,"^",1) ;segment "RTN","SDTMBUS",29,0) S ERR(1,1,2)=$P(ERROR,"^",2) ;sequence "RTN","SDTMBUS",30,0) S ERR(1,1,3)=$P(ERROR,"^",3) ;field "RTN","SDTMBUS",31,0) S ERR(1,1,4,1)=$P(ERROR,"^",4) ;code "RTN","SDTMBUS",32,0) S ERR(1,1,4,2)=$$ESCAPE^SDHL7UL($P(ERROR,"^",6),.HL) ;text "RTN","SDTMBUS",33,0) Q $$BLDSEG^SDHL7UL(.ERR,.HL) "RTN","SDTMBUS",34,0) ; "RTN","SDTMBUS",35,0) QAK(HL,ERROR) ;build QAK segment "RTN","SDTMBUS",36,0) N QAK,STATUS "RTN","SDTMBUS",37,0) S STATUS=$P(ERROR,"^",5) "RTN","SDTMBUS",38,0) I STATUS="" S STATUS="OK" "RTN","SDTMBUS",39,0) S QAK(0)="QAK" "RTN","SDTMBUS",40,0) S QAK(1)=HL("MID") ;ACK code "RTN","SDTMBUS",41,0) S QAK(2)=STATUS ;message control ID "RTN","SDTMBUS",42,0) S QAK(3)="" "RTN","SDTMBUS",43,0) Q $$BLDSEG^SDHL7UL(.QAK,.HL) "RTN","SDTMBUS",44,0) ; "RTN","SDTMBUS",45,0) QPD(QPD,HL) ;build QPD segment "RTN","SDTMBUS",46,0) Q $$BLDSEG^SDHL7UL(.QPD,.HL) "RTN","SDTMBUS",47,0) ; "RTN","SDTMBUS",48,0) QRF(QRY,EXTIME,HL) ; Build QRF segment "RTN","SDTMBUS",49,0) N QRF "RTN","SDTMBUS",50,0) M QRF=QRY("QRF") "RTN","SDTMBUS",51,0) S QRF(0)="QRF" "RTN","SDTMBUS",52,0) Q $$BLDSEG^SDHL7UL(.QRF,.HL) "RTN","SDTMBUS",53,0) ; "RTN","SDTMBUS",54,0) RDF(RDF,HL) ; Build RDF segment for DSS Units data "RTN","SDTMBUS",55,0) ; "RTN","SDTMBUS",56,0) ; Input: "RTN","SDTMBUS",57,0) ; HL - HL7 package array variable "RTN","SDTMBUS",58,0) ; "RTN","SDTMBUS",59,0) ; Output: "RTN","SDTMBUS",60,0) ; - Populated message array "RTN","SDTMBUS",61,0) ; "RTN","SDTMBUS",62,0) Q $$BLDSEG^SDHL7UL(.RDF,.HL) "RTN","SDTMBUS",63,0) ; "RTN","SDTMBUS",64,0) RDT(MSGROOT,DATAROOT,CNT,LEN,HL,FOUND) ; Build RDT segments for Consults elements "RTN","SDTMBUS",65,0) ; "RTN","SDTMBUS",66,0) ; Walks data in DATAROOT to populate MSGROOT with RDT segments "RTN","SDTMBUS",67,0) ; sequentially numbered starting at CNT "RTN","SDTMBUS",68,0) ; "RTN","SDTMBUS",69,0) ; Integration Agreements: "RTN","SDTMBUS",70,0) ; 10103 : FMTHL7^XLFDT "RTN","SDTMBUS",71,0) ; "RTN","SDTMBUS",72,0) ; Input: "RTN","SDTMBUS",73,0) ; MSGROOT - Root of array holding the message "RTN","SDTMBUS",74,0) ; DATAROOT - Root of array to hold extract data "RTN","SDTMBUS",75,0) ; CNT - Current message line counter "RTN","SDTMBUS",76,0) ; LEN - Current message length "RTN","SDTMBUS",77,0) ; HL - HL7 package array variable "RTN","SDTMBUS",78,0) ; FOUND - (0/1) Flag to indicate consults returned (1) or not (0) "RTN","SDTMBUS",79,0) ; "RTN","SDTMBUS",80,0) ; Output: "RTN","SDTMBUS",81,0) ; - Populated message array "RTN","SDTMBUS",82,0) ; - Updated LEN and CNT "RTN","SDTMBUS",83,0) ; "RTN","SDTMBUS",84,0) ; POPULATE SEQUENCE NUMBER "RTN","SDTMBUS",85,0) N I,APP,RDT,II,XDT,IEN,DATA,TO,XX,STOP,FS,CC "RTN","SDTMBUS",86,0) S FOUND=0 "RTN","SDTMBUS",87,0) ; "RTN","SDTMBUS",88,0) S FS="~" "RTN","SDTMBUS",89,0) F CC=1:1 Q:'$D(@DATAROOT@(CC)) D "RTN","SDTMBUS",90,0) . S APP=@DATAROOT@(CC,0) "RTN","SDTMBUS",91,0) . N RDT,TO,XX,XDT,IEN,CONSULTS,DATA,STOPDT,REMOTECS,RMTCNID,RMTCS,CONDT "RTN","SDTMBUS",92,0) . S DATA="RDT" "RTN","SDTMBUS",93,0) . S IEN=$P(^TMP("ORQQCN",$J,"CS",CC,0),U) "RTN","SDTMBUS",94,0) . Q:+IEN=0 "RTN","SDTMBUS",95,0) . S CONSULTS=$G(^TMP("ORQQCN",$J,"CS",CC,0)) "RTN","SDTMBUS",96,0) . S CONDT=$P(CONSULTS,"^",2),STOPDT=$$FMADD^XLFDT(DT,-365) "RTN","SDTMBUS",97,0) . Q:$G(CONDT)0 REMOTECS=RMTCS_","_RMTCNID "RTN","SDTMBUS",103,0) . S XDT=$G(RDT(123,+IEN_",","17","I")) "RTN","SDTMBUS",104,0) . S:$G(XDT)'="" XDT=$$TMCONV(XDT) "RTN","SDTMBUS",105,0) . S TO=+$P($G(^GMR(123,+IEN,0)),U,5) ;ICR 4837 "RTN","SDTMBUS",106,0) . S XX=0,STOP="" F S XX=$O(^GMR(123.5,TO,688,XX)) Q:XX'>0!(XX>5) S STOP=$G(STOP)_$P(^GMR(123.5,TO,688,XX,0),U)_"," "RTN","SDTMBUS",107,0) . S DATA=DATA_FS_$G(XDT)_FS_STOP_FS_$G(RDT(123,+IEN_",","10","E"))_FS_$G(REMOTECS)_FS_$$UP^XLFSTR($P(CONSULTS,"^",3)) "RTN","SDTMBUS",108,0) . F II=1:1:9 S RDT(II)=$P(DATA,II,FS) "RTN","SDTMBUS",109,0) . S CNT=CNT+1 "RTN","SDTMBUS",110,0) . S @MSGROOT@(CNT)=DATA "RTN","SDTMBUS",111,0) . S LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDTMBUS",112,0) . S FOUND=1 "RTN","SDTMBUS",113,0) . Q "RTN","SDTMBUS",114,0) Q "RTN","SDTMBUS",115,0) RTCRDT(MSGROOT,DATAROOT,CNT,LEN,HL,FOUND) ; Build RDT segments for Return to Clinic elements "RTN","SDTMBUS",116,0) ; "RTN","SDTMBUS",117,0) ; Walks data in DATAROOT to populate MSGROOT with RDT segments "RTN","SDTMBUS",118,0) ; sequentially numbered starting at CNT "RTN","SDTMBUS",119,0) ; "RTN","SDTMBUS",120,0) ; Integration Agreements: "RTN","SDTMBUS",121,0) ; 10103 : FMTHL7^XLFDT "RTN","SDTMBUS",122,0) ; "RTN","SDTMBUS",123,0) ; Input: "RTN","SDTMBUS",124,0) ; MSGROOT - Root of array holding the message "RTN","SDTMBUS",125,0) ; DATAROOT - Root of array to hold extract data "RTN","SDTMBUS",126,0) ; CNT - Current message line counter "RTN","SDTMBUS",127,0) ; LEN - Current message length "RTN","SDTMBUS",128,0) ; HL - HL7 package array variable "RTN","SDTMBUS",129,0) ; FOUND - (0/1) Flag to indicate consults returned (1) or not (0) "RTN","SDTMBUS",130,0) ; "RTN","SDTMBUS",131,0) ; Output: "RTN","SDTMBUS",132,0) ; - Populated message array "RTN","SDTMBUS",133,0) ; - Updated LEN and CNT "RTN","SDTMBUS",134,0) N I,RDT,II,XDT,IEN,DATA,TO,XX,STOP,FS,CC "RTN","SDTMBUS",135,0) S FOUND=0 "RTN","SDTMBUS",136,0) ; "RTN","SDTMBUS",137,0) S FS="~" "RTN","SDTMBUS",138,0) S CC=0 "RTN","SDTMBUS",139,0) F S CC=$O(@DATAROOT@(CC)) Q:'CC D "RTN","SDTMBUS",140,0) . N RDT,TO,XX,XDT,IEN,CONSULTS,DATA,STOPDT,REMOTECS,RMTCNID,RMTCS,CONDT,MRTC,RTCINT,RTCPAR,MULTIRTC,PRVID,PRVNM "RTN","SDTMBUS",141,0) . S DATA="RDT" "RTN","SDTMBUS",142,0) . S IEN=$P(@DATAROOT@(CC),U) "RTN","SDTMBUS",143,0) . Q:+IEN=0 "RTN","SDTMBUS",144,0) . S REQDT=$P(@DATAROOT@(CC),U,2) "RTN","SDTMBUS",145,0) . S CLINID=$P(@DATAROOT@(CC),U,3) "RTN","SDTMBUS",146,0) . S CID=$P(@DATAROOT@(CC),U,4) "RTN","SDTMBUS",147,0) . S PRVID=$P(@DATAROOT@(CC),U,5) "RTN","SDTMBUS",148,0) . S CMTS=$P(@DATAROOT@(CC),U,6) "RTN","SDTMBUS",149,0) . S MRTC=$P(@DATAROOT@(CC),U,7) "RTN","SDTMBUS",150,0) . S RTCINT=$P(@DATAROOT@(CC),U,8) "RTN","SDTMBUS",151,0) . S RTCPAR=$P(@DATAROOT@(CC),U,9) "RTN","SDTMBUS",152,0) . S:$L(MRTC)>0 MULTIRTC=$G(MRTC)_","_$G(RTCINT)_","_$G(RTCPAR) "RTN","SDTMBUS",153,0) . I +CLINID D "RTN","SDTMBUS",154,0) . . S CLINNM=$$GET1^DIQ(44,CLINID_",",".01") Q:CLINNM="" "RTN","SDTMBUS",155,0) . . S STOP=$$GET1^DIQ(44,CLINID_",",8,"I")_","_$$GET1^DIQ(44,CLINID_",",2503,"I") "RTN","SDTMBUS",156,0) . I +PRVID D "RTN","SDTMBUS",157,0) . . S PRVNM=$$GET1^DIQ(200,PRVID_",",".01") "RTN","SDTMBUS",158,0) . S STOPDT=$$FMADD^XLFDT(DT,-365) "RTN","SDTMBUS",159,0) . Q:$G(REQDT)0 "RTN","SDTMP08",112,0) S ^SC(SDECSCD,"ST",SD\1,1)=S "RTN","SDTMP08",113,0) Q "RTN","SDTMP08",114,0) ; "RTN","SDTMP08",115,0) APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ; "RTN","SDTMP08",116,0) ;Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDTMP08",117,0) ;at time SDECSD "RTN","SDTMP08",118,0) N SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H "RTN","SDTMP08",119,0) ;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length) "RTN","SDTMP08",120,0) S SDECPNOD=^DPT(SDECPATID,"S",SDECSD,0) "RTN","SDTMP08",121,0) S DPTST=$P(SDECPNOD,U,2) "RTN","SDTMP08",122,0) S DIE=409.84 "RTN","SDTMP08",123,0) S DA=SDECAPTID "RTN","SDTMP08",124,0) S DR=".17///"_DPTST_";"_".18///"_SDECLEN "RTN","SDTMP08",125,0) D ^DIE "RTN","SDTMP08",126,0) S SDECC("PAT")=SDECDFN "RTN","SDTMP08",127,0) S SDECC("CLN")=SDECLOC "RTN","SDTMP08",128,0) S SDECC("TYP")=SDECTYP "RTN","SDTMP08",129,0) S SDECC("ADT")=SDECSD "RTN","SDTMP08",130,0) S %H=$H D YMD^%DTC "RTN","SDTMP08",131,0) S SDECC("CDT")=SDECDATE ;X+% "RTN","SDTMP08",132,0) S SDECC("NOT")=SDECNOT "RTN","SDTMP08",133,0) S:+SDECCR SDECC("CR")=SDECCR "RTN","SDTMP08",134,0) S SDECC("USR")=SDUSER "RTN","SDTMP08",135,0) ; "RTN","SDTMP08",136,0) S SDECZ=$$CANCEL(.SDECC) "RTN","SDTMP08",137,0) Q "RTN","SDTMP08",138,0) ; "RTN","SDTMP08",139,0) SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF) ;cancel SDEC APPOINTMENT entry "RTN","SDTMP08",140,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file "RTN","SDTMP08",141,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDTMP08",142,0) ; C=CANCELLED BY CLINIC "RTN","SDTMP08",143,0) ; PC=CANCELLED BY PATIENT "RTN","SDTMP08",144,0) ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2) "RTN","SDTMP08",145,0) ;SDECNOT - (optional) text representing user note "RTN","SDTMP08",146,0) ;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ; "RTN","SDTMP08",147,0) ;SDF - (optional) flags "RTN","SDTMP08",148,0) ; 1. called from GUI (update consult only if called from GUI) "RTN","SDTMP08",149,0) ; 2. called from cancel in SDAM (CAN^SDCNP0) (do not reopen appt) "RTN","SDTMP08",150,0) ;Cancel SDEC APPOINTMENT entry "RTN","SDTMP08",151,0) N DFN,PROVIEN,Y "RTN","SDTMP08",152,0) N SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT ;alb/sat 651 add SAVESTRT and SDRES "RTN","SDTMP08",153,0) S SDF=$G(SDF,0) "RTN","SDTMP08",154,0) S DFN=$$GET1^DIQ(409.84,SDECAPTID_",",.05) ;alb/sat 658 "RTN","SDTMP08",155,0) S SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I") "RTN","SDTMP08",156,0) S SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01) ;alb/sat 651 "RTN","SDTMP08",157,0) S SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I") ;alb/sat 651 "RTN","SDTMP08",158,0) S SDECIENS=SDECAPTID_"," "RTN","SDTMP08",159,0) S SDECFDA(409.84,SDECIENS,.12)=$S($G(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT) "RTN","SDTMP08",160,0) S SDECFDA(409.84,SDECIENS,.121)=$S($G(SDUSER)'="":SDUSER,1:DUZ) "RTN","SDTMP08",161,0) S:$G(SDECCR)'="" SDECFDA(409.84,SDECIENS,.122)=SDECCR "RTN","SDTMP08",162,0) S SDECFDA(409.84,SDECIENS,.17)=SDECTYP "RTN","SDTMP08",163,0) K SDECMSG "RTN","SDTMP08",164,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDTMP08",165,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDTMP08",166,0) ;alb/sat 658 modification begin "RTN","SDTMP08",167,0) S SDECNOT=$G(SDECNOT),SDECNOT=$E(SDECNOT,1,160) "RTN","SDTMP08",168,0) I $L(SDECNOT)>2,'$E(SDF,2) K SDECFDA S SDECFDA(2.98,SDT_","_DFN_",",17)=SDECNOT D UPDATE^DIE("","SDECFDA") "RTN","SDTMP08",169,0) ;alb/sat 658 modification end "RTN","SDTMP08",170,0) I $P(SDAPTYP,";",2)="GMR(123,",$E(SDF,1) D "RTN","SDTMP08",171,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDTMP08",172,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDTMP08",173,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES) ;alb/sat 651 added SAVESTRT "RTN","SDTMP08",174,0) I $P(SDAPTYP,";",2)="SDWL(409.3," D ;update EWL "RTN","SDTMP08",175,0) .S DFN=$$GET1^DIQ(409.3,$P(SDAPTYP,";",1)_",",.01,"I") "RTN","SDTMP08",176,0) .Q:DFN="" "RTN","SDTMP08",177,0) .S SDIEN=0 F S SDIEN=$O(^SDWL(409.3,"B",DFN,SDIEN)) Q:SDIEN="" D "RTN","SDTMP08",178,0) ..I $$GET1^DIQ(409.3,SDIEN_",",13,"I")=SDT D "RTN","SDTMP08",179,0) ...K SDECFDA,SDECMSG,SDECWP "RTN","SDTMP08",180,0) ...;S SDIEN=$P(SDAPTYP,";",1) "RTN","SDTMP08",181,0) ...S SDECFDA(409.3,SDIEN_",",13)="@" "RTN","SDTMP08",182,0) ...S SDECFDA(409.3,SDIEN_",",13.1)="@" "RTN","SDTMP08",183,0) ...S SDECFDA(409.3,SDIEN_",",13.2)="@" "RTN","SDTMP08",184,0) ...S SDECFDA(409.3,SDIEN_",",13.3)="@" "RTN","SDTMP08",185,0) ...S SDECFDA(409.3,SDIEN_",",13.4)="@" "RTN","SDTMP08",186,0) ...S SDECFDA(409.3,SDIEN_",",13.5)="@" "RTN","SDTMP08",187,0) ...S SDECFDA(409.3,SDIEN_",",13.6)="@" "RTN","SDTMP08",188,0) ...S SDECFDA(409.3,SDIEN_",",13.7)="@" "RTN","SDTMP08",189,0) ...S SDECFDA(409.3,SDIEN_",",13.8)="@" "RTN","SDTMP08",190,0) ...D UPDATE^DIE("","SDECFDA") "RTN","SDTMP08",191,0) ...D:'$E(SDF,2) WLOPEN^SDECWL("","",SDIEN) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0 "RTN","SDTMP08",192,0) I $P(SDAPTYP,";",2)="SDEC(409.85," D ;update APPT "RTN","SDTMP08",193,0) .K SDECFDA,SDECMSG,SDECWP "RTN","SDTMP08",194,0) .D:'$E(SDF,2) AROPEN^SDECAR("",SDECAPTID) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0 "RTN","SDTMP08",195,0) .S SDIEN=$P(SDAPTYP,";",1) "RTN","SDTMP08",196,0) .S SDECFDA(409.85,SDIEN_",",13)="@" "RTN","SDTMP08",197,0) .S SDECFDA(409.85,SDIEN_",",13.1)="@" "RTN","SDTMP08",198,0) .S SDECFDA(409.85,SDIEN_",",13.2)="@" "RTN","SDTMP08",199,0) .S SDECFDA(409.85,SDIEN_",",13.3)="@" "RTN","SDTMP08",200,0) .S SDECFDA(409.85,SDIEN_",",13.4)="@" "RTN","SDTMP08",201,0) .S SDECFDA(409.85,SDIEN_",",13.5)="@" "RTN","SDTMP08",202,0) .S SDECFDA(409.85,SDIEN_",",13.6)="@" "RTN","SDTMP08",203,0) .S SDECFDA(409.85,SDIEN_",",13.7)="@" "RTN","SDTMP08",204,0) .S SDECFDA(409.85,SDIEN_",",13.8)="@" "RTN","SDTMP08",205,0) .D UPDATE^DIE("","SDECFDA") "RTN","SDTMP08",206,0) Q "RTN","SDTMP08",207,0) ; "RTN","SDTMP08",208,0) CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT event "RTN","SDTMP08",209,0) ;when appointments cancelled via PIMS interface. "RTN","SDTMP08",210,0) ;Propagates cancellation to SDECAPPT and raises refresh event to running GUI clients "RTN","SDTMP08",211,0) N SDECFOUND,SDECRES "RTN","SDTMP08",212,0) Q:+$G(SDECNOEV) "RTN","SDTMP08",213,0) Q:'+$G(SDECSC) "RTN","SDTMP08",214,0) S SDECFOUND=0 "RTN","SDTMP08",215,0) I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CANEVT1(SDECRES,SDECSTART,SDECPAT) "RTN","SDTMP08",216,0) I SDECFOUND D CANEVT3(SDECRES) Q "RTN","SDTMP08",217,0) Q "RTN","SDTMP08",218,0) ; "RTN","SDTMP08",219,0) CANEVT1(SDECRES,SDECSTART,SDECPAT) ; "RTN","SDTMP08",220,0) ;Get appointment id in SDECAPT "RTN","SDTMP08",221,0) ;If found, call SDECCAN(SDECAPPT) and return 1 "RTN","SDTMP08",222,0) ;else return 0 "RTN","SDTMP08",223,0) N SDECFOUND,SDECAPPT "RTN","SDTMP08",224,0) S SDECFOUND=0 "RTN","SDTMP08",225,0) Q:'+SDECRES SDECFOUND "RTN","SDTMP08",226,0) Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND "RTN","SDTMP08",227,0) S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND "RTN","SDTMP08",228,0) . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD="" "RTN","SDTMP08",229,0) . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q "RTN","SDTMP08",230,0) I SDECFOUND,+$G(SDECAPPT) D SDECCAN(SDECAPPT,,,,,,1) "RTN","SDTMP08",231,0) Q SDECFOUND "RTN","SDTMP08",232,0) ; "RTN","SDTMP08",233,0) CANEVT3(SDECRES) ; "RTN","SDTMP08",234,0) ;Call RaiseEvent to notify GUI clients "RTN","SDTMP08",235,0) ; "RTN","SDTMP08",236,0) Q "RTN","SDTMP08",237,0) N SDECRESN "RTN","SDTMP08",238,0) S SDECRESN=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDTMP08",239,0) Q:SDECRESN="" "RTN","SDTMP08",240,0) S SDECRESN=$P(SDECRESN,"^") "RTN","SDTMP08",241,0) ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","") "RTN","SDTMP08",242,0) ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN) "RTN","SDTMP08",243,0) Q "RTN","SDTMP08",244,0) ; "RTN","SDTMP08",245,0) CANCEL(BSDR) ;EP; called to cancel appt "RTN","SDTMP08",246,0) ; "RTN","SDTMP08",247,0) ; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY) "RTN","SDTMP08",248,0) ; "RTN","SDTMP08",249,0) ; Input Array - "RTN","SDTMP08",250,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDTMP08",251,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDTMP08",252,0) ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled "RTN","SDTMP08",253,0) ; BSDR("ADT") = appointment date and time "RTN","SDTMP08",254,0) ; BSDR("CDT") = cancel date and time "RTN","SDTMP08",255,0) ; BSDR("USR") = user who canceled appt "RTN","SDTMP08",256,0) ; BSDR("CR") = cancel reason - pointer to file 409.2 "RTN","SDTMP08",257,0) ; BSDR("NOT") = cancel remarks - optional notes to 160 characters "RTN","SDTMP08",258,0) ; "RTN","SDTMP08",259,0) ;Output: error status and message "RTN","SDTMP08",260,0) ; = 0 or null: everything okay "RTN","SDTMP08",261,0) ; = 1^message: error and reason "RTN","SDTMP08",262,0) ; "RTN","SDTMP08",263,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDTMP08",264,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDTMP08",265,0) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) "RTN","SDTMP08",266,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDTMP08",267,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDTMP08",268,0) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds "RTN","SDTMP08",269,0) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) "RTN","SDTMP08",270,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDTMP08",271,0) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) "RTN","SDTMP08",272,0) ; "RTN","SDTMP08",273,0) NEW IEN,DIE,DA,DR,SDMODE "RTN","SDTMP08",274,0) S IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","SDTMP08",275,0) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDTMP08",276,0) ; "RTN","SDTMP08",277,0) I $$CI^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until check-in deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDTMP08",278,0) ; "RTN","SDTMP08",279,0) ; remember before status "RTN","SDTMP08",280,0) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL "RTN","SDTMP08",281,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN "RTN","SDTMP08",282,0) S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDTMP08",283,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) "RTN","SDTMP08",284,0) ; "RTN","SDTMP08",285,0) ; get user who made appt and date appt made from ^SC "RTN","SDTMP08",286,0) ; because data in ^SC will be deleted "RTN","SDTMP08",287,0) NEW USER,DATE "RTN","SDTMP08",288,0) S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) "RTN","SDTMP08",289,0) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) "RTN","SDTMP08",290,0) ; "RTN","SDTMP08",291,0) ; update file 2 info "RTN","SDTMP08",292,0) NEW DIE,DA,DR "RTN","SDTMP08",293,0) N SDFDA,SDIEN,SDMSG "RTN","SDTMP08",294,0) S SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")" "RTN","SDTMP08",295,0) S @SDFDA@(3)=BSDR("TYP") "RTN","SDTMP08",296,0) S @SDFDA@(14)=BSDR("USR") "RTN","SDTMP08",297,0) S @SDFDA@(15)=BSDR("CDT") "RTN","SDTMP08",298,0) S:+$G(BSDR("CR")) @SDFDA@(16)=BSDR("CR") "RTN","SDTMP08",299,0) S:$G(BSDR("NOT"))]"" @SDFDA@(17)=$E(BSDR("NOT"),1,160) "RTN","SDTMP08",300,0) S @SDFDA@(19)=USER "RTN","SDTMP08",301,0) S @SDFDA@(20)=DATE "RTN","SDTMP08",302,0) D UPDATE^DIE("","SDFDA") "RTN","SDTMP08",303,0) S DUZ=$G(MSGARY("DUZ")) "RTN","SDTMP08",304,0) S:$G(DUZ(2))="" DUZ=$$KSP^XUPARAM("SITE") "RTN","SDTMP08",305,0) N SDPCE "RTN","SDTMP08",306,0) S SDPCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20) "RTN","SDTMP08",307,0) D:+SDPCE EN^SDCODEL(SDPCE,0) ;remove OUTPATIENT ENCOUNTER link "RTN","SDTMP08",308,0) ; "RTN","SDTMP08",309,0) ; delete data in ^SC "RTN","SDTMP08",310,0) NEW DIK,DA "RTN","SDTMP08",311,0) S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","SDTMP08",312,0) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN "RTN","SDTMP08",313,0) D ^DIK "RTN","SDTMP08",314,0) ; call event driver "RTN","SDTMP08",315,0) S SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDTMP08",316,0) ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) "RTN","SDTMP08",317,0) Q 0 "RTN","SDTMP08",318,0) ; "RTN","SDTMP08",319,0) UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment "RTN","SDTMP08",320,0) ;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC "RTN","SDTMP08",321,0) ;called by SDEC UNCANCEL APPT "RTN","SDTMP08",322,0) ; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84 "RTN","SDTMP08",323,0) N SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART "RTN","SDTMP08",324,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used? "RTN","SDTMP08",325,0) ; "RTN","SDTMP08",326,0) S SDECI=0 "RTN","SDTMP08",327,0) K ^TMP("SDEC",$J) "RTN","SDTMP08",328,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDTMP08",329,0) S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30) "RTN","SDTMP08",330,0) ;TSTART "RTN","SDTMP08",331,0) ;I '+SDECAPTID TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID.") Q "RTN","SDTMP08",332,0) I '+SDECAPTID D ERR(SDECI+1,"Invalid Appointment ID.") Q "RTN","SDTMP08",333,0) ;I '$D(^SDEC(409.84,SDECAPTID,0)) TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID") Q "RTN","SDTMP08",334,0) I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR(SDECI+1,"Invalid Appointment ID") Q "RTN","SDTMP08",335,0) ;Make sure appointment is cancelled "RTN","SDTMP08",336,0) ;I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" TROLLBACK D ERR(SDECI+1,"Appointment is not Cancelled.") Q "RTN","SDTMP08",337,0) I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" D ERR(SDECI+1,"Appointment is not Cancelled.") Q "RTN","SDTMP08",338,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDTMP08",339,0) ;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */ "RTN","SDTMP08",340,0) ;I $P(^DPT($P(SDECNOD,U,5),"S",$P(SDECNOD,U,1),0),U,2)="PC" TROLLBACK D ERR(SDECI+1,"Cancelled by patient appointment cannot be uncancelled.") Q "RTN","SDTMP08",341,0) ;get appointment data "RTN","SDTMP08",342,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDTMP08",343,0) S SDECDAM=$P(SDECNOD,U,9) ;date appt made "RTN","SDTMP08",344,0) S SDECDEC=$P(SDECNOD,U,8) ;data entry clerk "RTN","SDTMP08",345,0) S SDECLEN=$P(SDECNOD,U,18) ;length of appt in minutes "RTN","SDTMP08",346,0) S SDECNOTE=$G(^SDEC(409.84,SDECAPTID,1,1,0)) ;note from SDEC APPOINTMENT "RTN","SDTMP08",347,0) S SDECPATID=$P(SDECNOD,U,5) ;pointer to VA PATIENT file 2 "RTN","SDTMP08",348,0) S SDECSC1=$P($G(SDECNOD),U,7) ;resource "RTN","SDTMP08",349,0) S SDECSTART=$P(SDECNOD,U) ;appt start time "RTN","SDTMP08",350,0) S SDECWKIN=$P($G(SDECNOD),U,13) ;walk-in "RTN","SDTMP08",351,0) ;lock SDEC node "RTN","SDTMP08",352,0) ;L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q "RTN","SDTMP08",353,0) L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") Q "RTN","SDTMP08",354,0) ;un-cancel SDEC APPOINTMENT "RTN","SDTMP08",355,0) D SDECUCAN(SDECAPTID) "RTN","SDTMP08",356,0) I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=SDECERR_$P(SDECZ,U,2) D ERR(SDECI,SDECERR) Q "RTN","SDTMP08",357,0) . S SDECLOC="" "RTN","SDTMP08",358,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDTMP08",359,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDTMP08",360,0) . I SDECLOC="" S SDECLOC=$$SDCL^SDECUTL(SDECAPTID) ;HOSPITAL LOCATION "RTN","SDTMP08",361,0) . Q:'+SDECLOC "RTN","SDTMP08",362,0) . ;un-cancel patient appointment and re-instate clinic appointment "RTN","SDTMP08",363,0) . S SDECZ="" "RTN","SDTMP08",364,0) . D APUCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN) "RTN","SDTMP08",365,0) ;TCOMMIT "RTN","SDTMP08",366,0) L -^SDEC(409.84,SDECPATID) "RTN","SDTMP08",367,0) S SDECI=SDECI+1 "RTN","SDTMP08",368,0) S ^TMP("SDEC",$J,SDECI)=""_$C(30) "RTN","SDTMP08",369,0) S SDECI=SDECI+1 "RTN","SDTMP08",370,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDTMP08",371,0) Q "RTN","SDTMP08",372,0) ; "RTN","SDTMP08",373,0) SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time "RTN","SDTMP08",374,0) N PROVIEN,SDAPTYP,SDCL,SDRES "RTN","SDTMP08",375,0) S SDECIENS=SDECAPTID_"," "RTN","SDTMP08",376,0) S SDECFDA(409.84,SDECIENS,.12)="" "RTN","SDTMP08",377,0) K SDECMSG "RTN","SDTMP08",378,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDTMP08",379,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDTMP08",380,0) I $P(SDAPTYP,";",2)="GMR(123," D "RTN","SDTMP08",381,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDTMP08",382,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDTMP08",383,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",1) "RTN","SDTMP08",384,0) Q "RTN","SDTMP08",385,0) ; "RTN","SDTMP08",386,0) APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ; "RTN","SDTMP08",387,0) ;un-Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDTMP08",388,0) ; SDECLOC = pointer to hospital location ^SC file 44 "RTN","SDTMP08",389,0) ; SDECPATID = pointer to VA Patient ^DPT file 2 "RTN","SDTMP08",390,0) ; SDECSTART = Appointment time "RTN","SDTMP08",391,0) ; SDECDAM = Date appointment made in FM format "RTN","SDTMP08",392,0) ; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200 "RTN","SDTMP08",393,0) N SDECC,%H "RTN","SDTMP08",394,0) S SDECC("PAT")=SDECPATID "RTN","SDTMP08",395,0) S SDECC("CLN")=SDECLOC "RTN","SDTMP08",396,0) S SDECC("ADT")=SDECSTART "RTN","SDTMP08",397,0) S SDECC("NOTE")=SDECNOTE ;user note "RTN","SDTMP08",398,0) S SDECC("RES")=SDECRES "RTN","SDTMP08",399,0) S SDECC("USR")=DUZ "RTN","SDTMP08",400,0) S SDECC("LEN")=SDECLEN "RTN","SDTMP08",401,0) S SDECC("WKIN")=SDECWKIN "RTN","SDTMP08",402,0) ; "RTN","SDTMP08",403,0) S SDECZ=$$UNCANCEL(.SDECC) "RTN","SDTMP08",404,0) Q "RTN","SDTMP08",405,0) ; "RTN","SDTMP08",406,0) UNCANCEL(BSDR) ;PEP; called to un-cancel appt "RTN","SDTMP08",407,0) ; "RTN","SDTMP08",408,0) ; Make call using: S ERR=$$UNCANCEL(.ARRAY) "RTN","SDTMP08",409,0) ; "RTN","SDTMP08",410,0) ; Input Array - "RTN","SDTMP08",411,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDTMP08",412,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDTMP08",413,0) ; BSDR("ADT") = appointment date and time "RTN","SDTMP08",414,0) ; BSDR("USR") = user who un-canceled appt "RTN","SDTMP08",415,0) ; BSDR("NOTE") = appointment note from SDEC APPOINTMENT "RTN","SDTMP08",416,0) ; BSDR("LEN") = appt length in minutes (numeric) "RTN","SDTMP08",417,0) ; BSDR("RES") = resource "RTN","SDTMP08",418,0) ; BSDR("WKIN")= walk-in "RTN","SDTMP08",419,0) ; "RTN","SDTMP08",420,0) ;Output: error status and message "RTN","SDTMP08",421,0) ; = 0 or null: everything okay "RTN","SDTMP08",422,0) ; = 1^message: error and reason "RTN","SDTMP08",423,0) ; "RTN","SDTMP08",424,0) N DPTNOD,DPTNODR "RTN","SDTMP08",425,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDTMP08",426,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDTMP08",427,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDTMP08",428,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDTMP08",429,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDTMP08",430,0) ; "RTN","SDTMP08",431,0) S SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI) ;alb/sat 665 APPVISTA moved to SDEC07B "RTN","SDTMP08",432,0) Q SDECERR "RTN","SDTMP08",433,0) ; "RTN","SDTMP08",434,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDTMP08",435,0) S SDECI=SDECI+1 "RTN","SDTMP08",436,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDTMP08",437,0) ;TROLLBACK "RTN","SDTMP08",438,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDTMP08",439,0) S SDECI=SDECI+1 "RTN","SDTMP08",440,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDTMP08",441,0) Q "RTN","SDTMP08",442,0) ; "RTN","SDTMP08",443,0) ETRAP ;EP Error trap entry "RTN","SDTMP08",444,0) D ^%ZTER "RTN","SDTMP08",445,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDTMP08",446,0) S SDECI=SDECI+1 "RTN","SDTMP08",447,0) D ERR(SDECI,"SDEC08 Error") "RTN","SDTMP08",448,0) Q "RTN","SDTMP704") 0^13^B46513744^n/a "RTN","SDTMP704",1,0) SDTMP704 ;;MS/PB - TMP POST INSTALL;July 05, 2018 "RTN","SDTMP704",2,0) ;;5.3;Scheduling;**704**;May 29, 2018;Build 64 "RTN","SDTMP704",3,0) ;Post install routine to create new indexes in Patch SD*5.3*704 "RTN","SDTMP704",4,0) ;This routine will be deleted at the end of the install "RTN","SDTMP704",5,0) ;by the KIDS install process "RTN","SDTMP704",6,0) Q "RTN","SDTMP704",7,0) EN ; "RTN","SDTMP704",8,0) D LINK "RTN","SDTMP704",9,0) D ATMP1 "RTN","SDTMP704",10,0) D AX298 "RTN","SDTMP704",11,0) D AY298 "RTN","SDTMP704",12,0) Q "RTN","SDTMP704",13,0) LINK ; update the TMP_Send Link "RTN","SDTMP704",14,0) N LIEN,OPSITE,DOMAIN,VAL,SDERR "RTN","SDTMP704",15,0) S VAL="TMP_Send" "RTN","SDTMP704",16,0) S LIEN=$$FIND1^DIC(870,,"B",.VAL) ;Q:'LIEN "RTN","SDTMP704",17,0) I $G(LIEN)>0 D "RTN","SDTMP704",18,0) .S FDA(870,LIEN_",",.02)=$$KSP^XUPARAM("INST") ; site station number "RTN","SDTMP704",19,0) .S FDA(870,LIEN_",",4.5)=1 ; auto start "RTN","SDTMP704",20,0) .S FDA(870,LIEN_",",400.01)="vaauscluhshhl7rtr401.aac.domain.ext" ; ip address "RTN","SDTMP704",21,0) .S FDA(870,LIEN_",",400.02)=6950 ; hl7 port "RTN","SDTMP704",22,0) .S FDA(870,LIEN_",",400.08)=6950 ; hlo port "RTN","SDTMP704",23,0) .D UPDATE^DIE(,"FDA","SDERR") K FDA "RTN","SDTMP704",24,0) .D MES^XPDUTL("") "RTN","SDTMP704",25,0) I $G(LIEN)'>0 D "RTN","SDTMP704",26,0) .K DIC,DIC(0),X,Y,DLAYGO "RTN","SDTMP704",27,0) .S DIC="^HLCS(870,",DLAYGO=870,DIC(0)="L",X="TMP_SEND" D FILE^DICN "RTN","SDTMP704",28,0) .I +$G(Y)'>0 D MES^XPDUTL("Unable to create the new TMP_SEND HL Logical Link.") "RTN","SDTMP704",29,0) .S LIEN=+Y "RTN","SDTMP704",30,0) .S FDA(870,LIEN_",",.02)=$$KSP^XUPARAM("INST") ; site station number "RTN","SDTMP704",31,0) .S FDA(870,LIEN_",",4.5)=1 ; auto start "RTN","SDTMP704",32,0) .S FDA(870,LIEN_",",400.01)="vaauscluhshhl7rtr401.aac.domain.ext" ; ip address "RTN","SDTMP704",33,0) .S FDA(870,LIEN_",",400.02)=6950 ; hl7 port "RTN","SDTMP704",34,0) .S FDA(870,LIEN_",",400.08)=6950 ; hlo port "RTN","SDTMP704",35,0) .D UPDATE^DIE(,"FDA","SDERR") K FDA "RTN","SDTMP704",36,0) .D MES^XPDUTL("") "RTN","SDTMP704",37,0) .Q "RTN","SDTMP704",38,0) I $D(SDERR) D Q ; something went wrong "RTN","SDTMP704",39,0) .D MES^XPDUTL("FileMan error when editing the TMP_Send Link.") "RTN","SDTMP704",40,0) D MES^XPDUTL("TMP_Send Link has been updated.") "RTN","SDTMP704",41,0) Q "RTN","SDTMP704",42,0) ATMP1 ; creates a new style index on the Hospital Location File (#44) "RTN","SDTMP704",43,0) ;Q:$O(^DD("IX","BB",44,"ATMP1",0)) "RTN","SDTMP704",44,0) N SDTMPX,SDTMPY "RTN","SDTMP704",45,0) S SDTMPX("FILE")=44,SDTMPX("NAME")="ATMP1" "RTN","SDTMP704",46,0) I $O(^DD("IX","BB",SDTMPX("FILE"),SDTMPX("NAME"),0)) D DELIXN^DDMOD(SDTMPX("FILE"),SDTMPX("NAME")) "RTN","SDTMP704",47,0) S SDTMPX("TYPE")="MU",SDTMPX("USE")="A" "RTN","SDTMP704",48,0) S SDTMPX("EXECUTION")="F",SDTMPX("ACTIVITY")="IR" "RTN","SDTMP704",49,0) S SDTMPX("SHORT DESCR")="TMP HL7" "RTN","SDTMP704",50,0) S SDTMPX("DESCR",1)="The Tele Health Management Platform (TMP) application" "RTN","SDTMP704",51,0) S SDTMPX("DESCR",2)="allows users to schedule and cancel appointments in VistA." "RTN","SDTMP704",52,0) S SDTMPX("DESCR",3)="TMP needs to be kept up to date with specific clinic" "RTN","SDTMP704",53,0) S SDTMPX("DESCR",4)="information in order to be able to accurately display" "RTN","SDTMP704",54,0) S SDTMPX("DESCR",5)="clinic information." "RTN","SDTMP704",55,0) S SDTMPX("DESCR",6)="" "RTN","SDTMP704",56,0) S SDTMPX("DESCR",7)="This index will trigger an update to be sent to the TMP" "RTN","SDTMP704",57,0) S SDTMPX("DESCR",8)="platform via HL7 when one of the fields below is edited for" "RTN","SDTMP704",58,0) S SDTMPX("DESCR",9)="a tele health clinic or if a new tele health clinic is" "RTN","SDTMP704",59,0) S SDTMPX("DESCR",10)="added. Tele health clinics are identified by either the" "RTN","SDTMP704",60,0) S SDTMPX("DESCR",11)="Stop Code Number (primary stop code) or the Credit Stop" "RTN","SDTMP704",61,0) S SDTMPX("DESCR",12)="Code (secondary stop code)." "RTN","SDTMP704",62,0) S SDTMPX("DESCR",13)="" "RTN","SDTMP704",63,0) S SDTMPX("DESCR",14)="Name (#.01) Stop Code Number (#8) Credit Stop Code (#2504)" "RTN","SDTMP704",64,0) S SDTMPX("DESCR",15)="Service (#9) Treating Specialty (#9.5) Overbooks/Day" "RTN","SDTMP704",65,0) S SDTMPX("DESCR",16)="Maximum (#1918) Inactivate Date (#2505) Reactivate Date" "RTN","SDTMP704",66,0) S SDTMPX("DESCR",17)="(#2506)." "RTN","SDTMP704",67,0) S SDTMPX("SET CONDITION")="S X=X1(1)'=""""!X1(2)'=""""!X1(3)'=""""!X1(4)'=""""!X1(5)'=""""!X1(6)'=""""!X1(7)'=""""!X1(8)'=""""!X1(9)'=""""" "RTN","SDTMP704",68,0) S SDTMPX("SET")="D EN^SDTMPHLB(DA)" "RTN","SDTMP704",69,0) S SDTMPX("KILL")="Q" "RTN","SDTMP704",70,0) ;S SDTMPX("WHOLE KILL")="Q" "RTN","SDTMP704",71,0) S SDTMPX("VAL",1)=.01 ;Name "RTN","SDTMP704",72,0) S SDTMPX("VAL",2)=8 ;Stop Code Number "RTN","SDTMP704",73,0) S SDTMPX("VAL",3)=2503 ;Credit Stop Code "RTN","SDTMP704",74,0) S SDTMPX("VAL",4)=9.5 ;Treating Specialty "RTN","SDTMP704",75,0) S SDTMPX("VAL",5)=9 ;Service "RTN","SDTMP704",76,0) S SDTMPX("VAL",6)=16 ;Default Provider "RTN","SDTMP704",77,0) S SDTMPX("VAL",7)=1918 ;Overbooks/Day Maximum "RTN","SDTMP704",78,0) S SDTMPX("VAL",8)=2505 ;Inactive date "RTN","SDTMP704",79,0) S SDTMPX("VAL",9)=2506 ;Reactivate date "RTN","SDTMP704",80,0) D CREIXN^DDMOD(.SDTMPX,"",.SDTMPY) ;SDTMPY=ien^name of index "RTN","SDTMP704",81,0) I +$G(SDTMPY)>0 N IEN S IEN=+SDTMPY,^DD("IX",IEN,"NOREINDEX")=1 "RTN","SDTMP704",82,0) Q "RTN","SDTMP704",83,0) ; "RTN","SDTMP704",84,0) AX298 ; creates the ATMP1 cross reference in the appointment multiple in the patient file. "RTN","SDTMP704",85,0) ;Q:$O(^DD("IX","BB",2,"AX",0)) "RTN","SDTMP704",86,0) N SDTMPX,SDTMPY "RTN","SDTMP704",87,0) S SDTMPX("FILE")=2,SDTMPX("NAME")="AX",SDTMPX("ROOT FILE")=2.98 "RTN","SDTMP704",88,0) I $O(^DD("IX","BB",SDTMPX("FILE"),SDTMPX("NAME"),0)) D DELIXN^DDMOD(SDTMPX("FILE"),SDTMPX("NAME")) "RTN","SDTMP704",89,0) S SDTMPX("TYPE")="MU",SDTMPX("USE")="A" "RTN","SDTMP704",90,0) S SDTMPX("EXECUTION")="R",SDTMPX("ACTIVITY")="IR" "RTN","SDTMP704",91,0) S SDTMPX("SHORT DESCR")="Action cross reference to send HL7 notification to TMP when a new appt is made." "RTN","SDTMP704",92,0) S SDTMPX("DESCR",1)="The Tele Health Management Platform (TMP)" "RTN","SDTMP704",93,0) S SDTMPX("DESCR",2)="application allows users to schedule and cancel" "RTN","SDTMP704",94,0) S SDTMPX("DESCR",3)="tele health appointments in VistA. TMP needs to" "RTN","SDTMP704",95,0) S SDTMPX("DESCR",4)="be kept up to date with appointments scheduled" "RTN","SDTMP704",96,0) S SDTMPX("DESCR",5)="by other applications in order to be able to" "RTN","SDTMP704",97,0) S SDTMPX("DESCR",6)="accurately display open appointment slots. This" "RTN","SDTMP704",98,0) S SDTMPX("DESCR",7)="index will trigger an HL7 message sent to TMP" "RTN","SDTMP704",99,0) S SDTMPX("DESCR",8)="that will update the clinic's and patient's" "RTN","SDTMP704",100,0) S SDTMPX("DESCR",9)="appointments in the TMP database system." "RTN","SDTMP704",101,0) S SDTMPX("SET CONDITION")="S X=X1(1)=""""" "RTN","SDTMP704",102,0) S SDTMPX("SET")="D EN^SDTMPHLA(DA(1),DA)" "RTN","SDTMP704",103,0) S SDTMPX("KILL")="Q" "RTN","SDTMP704",104,0) ;S SDTMPX("WHOLE KILL")="Q" "RTN","SDTMP704",105,0) S SDTMPX("VAL",1)=.01 ;Name "RTN","SDTMP704",106,0) D CREIXN^DDMOD(.SDTMPX,"",.SDTMPY) ;SDTMPY=ien^name of index "RTN","SDTMP704",107,0) I +$G(SDTMPY)>0 N IEN S IEN=+SDTMPY,^DD("IX",IEN,"NOREINDEX")=1 "RTN","SDTMP704",108,0) Q "RTN","SDTMP704",109,0) ; "RTN","SDTMP704",110,0) AY298 ; creates the ATMP1 cross reference in the appointment multiple in the patient file. "RTN","SDTMP704",111,0) ;Q:$O(^DD("IX","BB",2,"AY",0)) "RTN","SDTMP704",112,0) N SDTMPX,SDTMPY "RTN","SDTMP704",113,0) S SDTMPX("FILE")=2,SDTMPX("NAME")="AY",SDTMPX("ROOT FILE")=2.98 "RTN","SDTMP704",114,0) I $O(^DD("IX","BB",SDTMPX("FILE"),SDTMPX("NAME"),0)) D DELIXN^DDMOD(SDTMPX("FILE"),SDTMPX("NAME")) "RTN","SDTMP704",115,0) S SDTMPX("TYPE")="MU",SDTMPX("USE")="A" "RTN","SDTMP704",116,0) S SDTMPX("EXECUTION")="F",SDTMPX("ACTIVITY")="IR" "RTN","SDTMP704",117,0) S SDTMPX("SHORT DESCR")="Action cross reference to send an HL7 notification when an appt is cancelled." "RTN","SDTMP704",118,0) S SDTMPX("DESCR",1)="The Tele Health Management Platform (TMP)" "RTN","SDTMP704",119,0) S SDTMPX("DESCR",2)="application allows users to schedule and cancel" "RTN","SDTMP704",120,0) S SDTMPX("DESCR",3)="tele health appointments in VistA. TMP needs to" "RTN","SDTMP704",121,0) S SDTMPX("DESCR",4)="be kept up to date with appointments are" "RTN","SDTMP704",122,0) S SDTMPX("DESCR",5)="cancelled by other applications in order to be" "RTN","SDTMP704",123,0) S SDTMPX("DESCR",6)="able to accurately display open appointment" "RTN","SDTMP704",124,0) S SDTMPX("DESCR",7)="slots. This index will trigger an HL7 message" "RTN","SDTMP704",125,0) S SDTMPX("DESCR",8)="sent to TMP that will update the clinic's and " "RTN","SDTMP704",126,0) S SDTMPX("DESCR",9)="patient's appointments in the TMP database" "RTN","SDTMP704",127,0) S SDTMPX("DESCR",10)="system to reflect the cancellation." "RTN","SDTMP704",128,0) S SDTMPX("SET CONDITION")="S X=X1(1)=""""" "RTN","SDTMP704",129,0) S SDTMPX("SET")="D EN^SDTMPHLA(DA(1),DA)" "RTN","SDTMP704",130,0) S SDTMPX("KILL")="Q" "RTN","SDTMP704",131,0) ;S SDTMPX("WHOLE KILL")="Q" "RTN","SDTMP704",132,0) S SDTMPX("VAL",1)=3 ;Status "RTN","SDTMP704",133,0) D CREIXN^DDMOD(.SDTMPX,"",.SDTMPY) ;SDTMPY=ien^name of index "RTN","SDTMP704",134,0) I +$G(SDTMPY)>0 N IEN S IEN=+SDTMPY,^DD("IX",IEN,"NOREINDEX")=1 "RTN","SDTMP704",135,0) Q "RTN","SDTMPHLA") 0^11^B121959808^n/a "RTN","SDTMPHLA",1,0) SDTMPHLA ;MS/PB - TMP HL7 Routine;May 29, 2018 "RTN","SDTMPHLA",2,0) ;;5.3;Scheduling;**704**;SEP 26, 2018;Build 64 "RTN","SDTMPHLA",3,0) Q "RTN","SDTMPHLA",4,0) EN(DFN,APTTM) ; Entry to the routine to build an HL7 message "RTN","SDTMPHLA",5,0) ;notification to TMP about a new appointment in a TeleHealth Clinic "RTN","SDTMPHLA",6,0) ; "RTN","SDTMPHLA",7,0) ;put in check for this to be a telehealth clinic. if not a telehealth clinic quit "RTN","SDTMPHLA",8,0) ;Call API to create MSH segment "RTN","SDTMPHLA",9,0) Q:$G(DFN)="" "RTN","SDTMPHLA",10,0) Q:$G(APTTM)="" "RTN","SDTMPHLA",11,0) N PARMS,SEG,WHOTO,SNODE,ANODE,CNODE,CLINODE,ERROR,MSG,ANODE1 "RTN","SDTMPHLA",12,0) S (SSTOP,PSTOP,STOP)=0 "RTN","SDTMPHLA",13,0) K CLINID "RTN","SDTMPHLA",14,0) S RTN=0,CAN=0 "RTN","SDTMPHLA",15,0) ;Q:'$D(^DPT(DFN,"S",APTTM,0)) "RTN","SDTMPHLA",16,0) S ANODE=$G(^DPT(DFN,"S",APTTM,0)) "RTN","SDTMPHLA",17,0) S ANODE1=$G(^DPT(DFN,"S",APTTM,1)) "RTN","SDTMPHLA",18,0) ;If this appointment was made by the TMP application, stop "RTN","SDTMPHLA",19,0) Q:$P(ANODE1,U,3)="TMP" "RTN","SDTMPHLA",20,0) S CLINID=$P(ANODE,U,1) "RTN","SDTMPHLA",21,0) S CLINODE=$G(^SC(CLINID,0)) "RTN","SDTMPHLA",22,0) S XX=0 F S XX=$O(^SC(CLINID,"S",APTTM,1,XX)) Q:XX'>0 D ;Get the correct appointment node for the patient "RTN","SDTMPHLA",23,0) .I $P(^SC(CLINID,"S",APTTM,1,XX,0),"^")=DFN S SNODE=$G(^SC(CLINID,"S",APTTM,1,XX,0)),CNODE=$P($G(^SC(CLINID,"S",APTTM,1,XX,"CONS")),"^") "RTN","SDTMPHLA",24,0) ;Q:$G(SNODE)="" ; If the appointment is not in the Hospital Location File stop. "RTN","SDTMPHLA",25,0) ;S PSTOP=$P(SNODE,"^",7),SSTOP=$P(SNODE,"^",18) "RTN","SDTMPHLA",26,0) S PSTOP=$P(CLINODE,"^",7),SSTOP=$P(CLINODE,"^",18) "RTN","SDTMPHLA",27,0) ;If both stop codes are null, stop the check, we know it is not a tele health clinic "RTN","SDTMPHLA",28,0) Q:($G(PSTOP)="")&(($G(SSTOP))="") "RTN","SDTMPHLA",29,0) S STOP=$$CHKCLIN(PSTOP) ;if STOP=0, primary stop code is not a tele health stop code so check secondary stop code to see if it is a tele health clinic "RTN","SDTMPHLA",30,0) ;I $G(STOP)=0,($$CHKCLIN(SSTOP)=0) Q ;if primary stop code is not tele health check secondary stop code if secondary not tele health stop "RTN","SDTMPHLA",31,0) I $G(STOP)=0 Q:$Q(SSTOP)="" S STOP=$$CHKCLIN(SSTOP) ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop "RTN","SDTMPHLA",32,0) Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic "RTN","SDTMPHLA",33,0) ; need code to stop processing if the appointment was made by TMP "RTN","SDTMPHLA",34,0) I $P($G(ANODE),"^",2)'="" S CAN=1 "RTN","SDTMPHLA",35,0) S SNODE=$G(^SC(CLINID,"S",APTTM,1,1,0)) "RTN","SDTMPHLA",36,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",37,0) S:CAN=0 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S12" "RTN","SDTMPHLA",38,0) S:CAN=1 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S15" "RTN","SDTMPHLA",39,0) I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) Q 0 "RTN","SDTMPHLA",40,0) S SEQ=1 "RTN","SDTMPHLA",41,0) D:CAN=0 SCH(DFN,SEQ,.SEG,ANODE,SNODE) "RTN","SDTMPHLA",42,0) I (CAN=0&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0 "RTN","SDTMPHLA",43,0) D:CAN=1 SCHCAN(DFN,SEQ,.SEG,ANODE,SNODE,CNODE) "RTN","SDTMPHLA",44,0) I (CAN=1&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0 "RTN","SDTMPHLA",45,0) D NTE(.SEQ,.SEG) "RTN","SDTMPHLA",46,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",47,0) D PID(DFN,SEQ,.SEG) "RTN","SDTMPHLA",48,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",49,0) D PV1(DFN,SEQ,.SEG) "RTN","SDTMPHLA",50,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",51,0) D RGS1("A",SEQ,.SEG) ;required segment "RTN","SDTMPHLA",52,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",53,0) D AIL1(ANODE,SEQ,.SEG) "RTN","SDTMPHLA",54,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",55,0) S PARMS("SENDING APPLICATION")="TMP_OUT" "RTN","SDTMPHLA",56,0) S PARMS("APP ACK TYPE")="AL" "RTN","SDTMPHLA",57,0) S WHOTO("RECEIVING APPLICATION")="TMP VIMT" "RTN","SDTMPHLA",58,0) S WHOTO("FACILITY LINK NAME")="TMP_SEND" "RTN","SDTMPHLA",59,0) S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0)) "RTN","SDTMPHLA",60,0) S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR) "RTN","SDTMPHLA",61,0) K CAN,APTSTATUS,SSTOP,PSTOP,STOP,CLINID,PROVID,PROVNM,XX "RTN","SDTMPHLA",62,0) Q RTN "RTN","SDTMPHLA",63,0) PID(DFN,SEQ,SEG) ; "RTN","SDTMPHLA",64,0) N VA,VADM,VAHOW,VAROOT,VATEST,VAPA,NAME,DOB,SSN,ICN,ADDRESS "RTN","SDTMPHLA",65,0) K SEG S SEG="" "RTN","SDTMPHLA",66,0) S VAHOW=1 "RTN","SDTMPHLA",67,0) D DEM^VADPT "RTN","SDTMPHLA",68,0) S NAME=VADM("NM") D STDNAME^XLFNAME(.NAME,"C") "RTN","SDTMPHLA",69,0) S DOB=$P(VADM("DB"),"^"),SSN=$P(VADM("SS"),"^") "RTN","SDTMPHLA",70,0) S VAHOW="" "RTN","SDTMPHLA",71,0) D ADD^VADPT "RTN","SDTMPHLA",72,0) S ADDRESS("STREET")=VAPA(1),ADDRESS("STREET2")=VAPA(2),ADDRESS("CITY")=VAPA(4),ADDRESS("STATE")=$P(VAPA(5),"^",2),ADDRESS("ZIP")=VAPA(6) "RTN","SDTMPHLA",73,0) S ICN=$$GETICN^MPIF001(DFN) "RTN","SDTMPHLA",74,0) D SET^HLOAPI(.SEG,"PID",0) ; Set segment type to PID "RTN","SDTMPHLA",75,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set PID-1 "RTN","SDTMPHLA",76,0) ; set ICN into PID-3, repitition 1 "RTN","SDTMPHLA",77,0) D SET^HLOAPI(.SEG,+ICN,3,1,1,1) ; Component 1, subcomponent 1, Patient ICN "RTN","SDTMPHLA",78,0) D SET^HLOAPI(.SEG,$P(ICN,"V",2),3,2,1,1) ; Component 1, subcomponent 2, Patient ICN checksum "RTN","SDTMPHLA",79,0) D SET^HLOAPI(.SEG,DFN,4,1,1,1) ; patient DFN "RTN","SDTMPHLA",80,0) D SET^HLOAPI(.SEG,"USVHA",3,4,1,1) ; component 4, subcomponent1 "RTN","SDTMPHLA",81,0) D SET^HLOAPI(.SEG,"0363",3,5,1,1) ; component 5 "RTN","SDTMPHLA",82,0) ; set SSN into PID-3, repetition 2 "RTN","SDTMPHLA",83,0) D SET^HLOAPI(.SEG,SSN,3,1,1,2) ;component 1, subcomponent1 "RTN","SDTMPHLA",84,0) D SET^HLOAPI(.SEG,"USSSA",3,4,1,2) ; Component 4, subcomponent 1 "RTN","SDTMPHLA",85,0) D SET^HLOAPI(.SEG,"0363",3,4,3,2) ; component 4, subcomponent 3 "RTN","SDTMPHLA",86,0) D SET^HLOAPI(.SEG,"SS",3,5,1,2) ; component 1 "RTN","SDTMPHLA",87,0) ;Set the name inot PID-5 "RTN","SDTMPHLA",88,0) D SETXPN^HLOAPI4(.SEG,.NAME,5) "RTN","SDTMPHLA",89,0) ; Set the DOB into PID-7 "RTN","SDTMPHLA",90,0) D SETDT^HLOAPI4(.SEG,DOB,7) "RTN","SDTMPHLA",91,0) ; set the address into PID-11 "RTN","SDTMPHLA",92,0) D SETAD^HLOAPI4(.SEG,.ADDRESS,11) "RTN","SDTMPHLA",93,0) Q "RTN","SDTMPHLA",94,0) PD1 ; Not needed right now "RTN","SDTMPHLA",95,0) Q "RTN","SDTMPHLA",96,0) PV1(DFN,SEQ,SEG) ; "RTN","SDTMPHLA",97,0) N FAC "RTN","SDTMPHLA",98,0) S CLASS="OUTPATIENT" "RTN","SDTMPHLA",99,0) S FAC=$$KSP^XUPARAM("INST") "RTN","SDTMPHLA",100,0) D SET^HLOAPI(.SEG,"PV1",0) ; Set the segment type "RTN","SDTMPHLA",101,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the PV1-1 "RTN","SDTMPHLA",102,0) ; set the PV1-2, patient class (tbl 5-20 in the TMP HL7 specification "RTN","SDTMPHLA",103,0) D SET^HLOAPI(.SEG,CLASS,2) ; "RTN","SDTMPHLA",104,0) ; set the PV1-4, Purpose of Visit "RTN","SDTMPHLA",105,0) D SET^HLOAPI(.SEG,APTSTATUS,4) "RTN","SDTMPHLA",106,0) ; set the PV1-7, provider "RTN","SDTMPHLA",107,0) D SET^HLOAPI(.SEG,$G(PROVID),7,1,1) "RTN","SDTMPHLA",108,0) D SET^HLOAPI(.SEG,$G(PROVNM),7,2,1) "RTN","SDTMPHLA",109,0) ; set the PV1-39 facility id "RTN","SDTMPHLA",110,0) D SET^HLOAPI(.SEG,FAC,39) "RTN","SDTMPHLA",111,0) K CLASS "RTN","SDTMPHLA",112,0) Q "RTN","SDTMPHLA",113,0) SCH(DFN,SEQ,SEG,ANODE,SNODE) ; update for new appointments "RTN","SDTMPHLA",114,0) N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,CONNM,PREMAIL "RTN","SDTMPHLA",115,0) ;S LENGTH=$P(^SC(CLINID,"SL"),"^",1),TMUNITS="M" "RTN","SDTMPHLA",116,0) S:$G(SNODE)'="" LENGTH=$P($G(SNODE),"^",2) "RTN","SDTMPHLA",117,0) S TMUNITS="M" "RTN","SDTMPHLA",118,0) S:$G(LENGTH)="" LENGTH=$G(SDECC("LEN")) "RTN","SDTMPHLA",119,0) S START=$$TMCONV(APTTM),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END) "RTN","SDTMPHLA",120,0) S:$G(CNODE)>0 CONNM=$P(^GMR(123.5,$P(^GMR(123,CNODE,0),"^",5),0),"^") "RTN","SDTMPHLA",121,0) S PROVID=$P(^SC(CLINID,0),"^",13) S:$G(PROVID)>0 PROVNM=$P(^VA(200,PROVID,0),"^"),PREMAIL=$P($G(^VA(200,PROVID,.15)),"^") "RTN","SDTMPHLA",122,0) K XS S (STATUS("ID"))=$S($P(ANODE,"^",2)="":"S",1:$P(ANODE,"^",2)) S:STATUS("ID")="S" STATUS("TEXT")="SCHEDULED" "RTN","SDTMPHLA",123,0) N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID")) "RTN","SDTMPHLA",124,0) S STATUS("SYSTEM")=2 "RTN","SDTMPHLA",125,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",126,0) S:$G(SNODE)'="" ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1) "RTN","SDTMPHLA",127,0) S:$G(SNODE)="" ENTEREDBY=$P(^VA(200,$G(DUZ),0),"^"),SCHEMAIL=$P($G(^VA(200,$G(DUZ),.15)),"^",1) "RTN","SDTMPHLA",128,0) D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type "RTN","SDTMPHLA",129,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1 "RTN","SDTMPHLA",130,0) D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status "RTN","SDTMPHLA",131,0) D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request "RTN","SDTMPHLA",132,0) ;D:$G(CONNM)'="" SET^HLOAPI(.SEG,CONNM,7,2) ;Consult name "RTN","SDTMPHLA",133,0) D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length "RTN","SDTMPHLA",134,0) D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units "RTN","SDTMPHLA",135,0) D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",136,0) D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",137,0) D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz "RTN","SDTMPHLA",138,0) D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name "RTN","SDTMPHLA",139,0) D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail "RTN","SDTMPHLA",140,0) D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment "RTN","SDTMPHLA",141,0) D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email "RTN","SDTMPHLA",142,0) D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment "RTN","SDTMPHLA",143,0) Q "RTN","SDTMPHLA",144,0) SCHCAN(DFN,SEQ,SEG,ANODE,SNODE,CNODE) ; update for cancelled appointments "RTN","SDTMPHLA",145,0) N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,PREMAIL "RTN","SDTMPHLA",146,0) Q:$G(SNODE)="" ;SNODE=SNODE=$G(^SC(CLINID,"S",APTTM,1,XX,0)) "RTN","SDTMPHLA",147,0) S:$G(DUZ)="" DUZ=.5 "RTN","SDTMPHLA",148,0) S:$G(DUZ(2))="" DUZ=$$KSP^XUPARAM("SITE") "RTN","SDTMPHLA",149,0) S LENGTH=$P(^SC(CLINID,"SL"),"^",1),TMUNITS="M" "RTN","SDTMPHLA",150,0) S START=$$TMCONV(APTTM),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END) "RTN","SDTMPHLA",151,0) S:$G(CNODE)>0 CONNM=$$GET1^DIQ(123,CNODE_",",1,"E") ;CONNM=$P(GMR(123.5,$P(^GMR(123,CNODE,0),"^",5),0),"^") "RTN","SDTMPHLA",152,0) S PROVID=$P(^SC(CLINID,0),"^",13) S:$G(PROVID)>0 PROVNM=$P(^VA(200,PROVID,0),"^"),PREMAIL=$P($G(^VA(200,PROVID,.15)),"^") "RTN","SDTMPHLA",153,0) K XS S (STATUS("ID"),XS)=$S($P(ANODE,"^",2)="":"S",1:$P(ANODE,"^",2)) S:STATUS("ID")="S" STATUS("TEXT")="SCHEDULED" "RTN","SDTMPHLA",154,0) N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID")) "RTN","SDTMPHLA",155,0) S STATUS("SYSTEM")=2 "RTN","SDTMPHLA",156,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",157,0) S ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1) "RTN","SDTMPHLA",158,0) D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type "RTN","SDTMPHLA",159,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1 "RTN","SDTMPHLA",160,0) D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status "RTN","SDTMPHLA",161,0) D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request "RTN","SDTMPHLA",162,0) ;D:$G(CONNM)'="" SET^HLOAPI(.SEG,CONNM,7,2) ;Consult name "RTN","SDTMPHLA",163,0) D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length "RTN","SDTMPHLA",164,0) D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units "RTN","SDTMPHLA",165,0) D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",166,0) D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",167,0) D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz "RTN","SDTMPHLA",168,0) D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name "RTN","SDTMPHLA",169,0) D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail "RTN","SDTMPHLA",170,0) D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment "RTN","SDTMPHLA",171,0) D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email "RTN","SDTMPHLA",172,0) D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment "RTN","SDTMPHLA",173,0) K SCHEMAIL "RTN","SDTMPHLA",174,0) Q "RTN","SDTMPHLA",175,0) PV2 ; Not needed right now "RTN","SDTMPHLA",176,0) Q "RTN","SDTMPHLA",177,0) OBX1 ; Not needed right now "RTN","SDTMPHLA",178,0) Q "RTN","SDTMPHLA",179,0) OBX2 ; Not needed right now "RTN","SDTMPHLA",180,0) Q "RTN","SDTMPHLA",181,0) OBX3 ; Not needed right now "RTN","SDTMPHLA",182,0) Q "RTN","SDTMPHLA",183,0) OBX4 ; Not needed right now "RTN","SDTMPHLA",184,0) Q "RTN","SDTMPHLA",185,0) RGS1(FLAG,SEQ,SEG) ; At least one RGS segment is required "RTN","SDTMPHLA",186,0) N GRP "RTN","SDTMPHLA",187,0) S GRP="" "RTN","SDTMPHLA",188,0) D SET^HLOAPI(.SEG,"RGS",0) "RTN","SDTMPHLA",189,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",190,0) D SET^HLOAPI(.SEG,FLAG,2) "RTN","SDTMPHLA",191,0) D SET^HLOAPI(.SEG,GRP,3) "RTN","SDTMPHLA",192,0) Q "RTN","SDTMPHLA",193,0) AIS1 ; "RTN","SDTMPHLA",194,0) Q "RTN","SDTMPHLA",195,0) NTE(SEQ,SEG) ; "RTN","SDTMPHLA",196,0) N NOTES,CLINID,CLINNM "RTN","SDTMPHLA",197,0) S NOTES="THESE ARE BOOKING NOTES",CLINID=23,CLINNM="GENERAL MEDICINE" "RTN","SDTMPHLA",198,0) D SET^HLOAPI(.SEG,"NTE",0) "RTN","SDTMPHLA",199,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",200,0) D SET^HLOAPI(.SEG,"NOTES",3) "RTN","SDTMPHLA",201,0) D SET^HLOAPI(.SEG,NOTES,4) "RTN","SDTMPHLA",202,0) Q "RTN","SDTMPHLA",203,0) AIL1(ANODE,SEQ,SEG) ; "RTN","SDTMPHLA",204,0) K LOC "RTN","SDTMPHLA",205,0) S LOC("ID")=$P(ANODE,"^",1),LOC("TEXT")=$P(^SC(LOC("ID"),0),"^"),LOC("SYSTEM")="44",CODE="A" ;^HOSPITAL LOCATIION",CODE="A" "RTN","SDTMPHLA",206,0) D SET^HLOAPI(.SEG,"AIL",0) "RTN","SDTMPHLA",207,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",208,0) D SET^HLOAPI(.SEG,CODE,2) "RTN","SDTMPHLA",209,0) D SETCE^HLOAPI4(.SEG,.LOC,4) "RTN","SDTMPHLA",210,0) K LOC,CODE "RTN","SDTMPHLA",211,0) Q "RTN","SDTMPHLA",212,0) TMCONV(X) ; "RTN","SDTMPHLA",213,0) ;convert time to Zulu timezone "RTN","SDTMPHLA",214,0) N TZONE,DIFF,UTC,UTC1,UTC2 "RTN","SDTMPHLA",215,0) S TZONE=$$GET1^DIQ(4.3,"1,",1,"I"),DIFF=$$GET1^DIQ(4.4,$G(TZONE)_",",2,"E")*(-1) "RTN","SDTMPHLA",216,0) S UTC=$$FMADD^XLFDT(X,,$G(DIFF),,),UTC2=$$FMTHL7^XLFDT(UTC) "RTN","SDTMPHLA",217,0) S UTC1=$E(UTC2,1,4)_"-"_$E(UTC2,5,6)_"-"_$E(UTC2,7,8)_"T"_$E(UTC2,9,10)_":"_$E(UTC2,11,12)_":00.000Z" "RTN","SDTMPHLA",218,0) Q UTC1 "RTN","SDTMPHLA",219,0) TEST ; "RTN","SDTMPHLA",220,0) N ST,EN,START,END "RTN","SDTMPHLA",221,0) S ST="3180508.0900",EN="3180508.0945" "RTN","SDTMPHLA",222,0) S START=$$TMCONV(ST),END=$$TMCONV(EN) "RTN","SDTMPHLA",223,0) W !,START," ",END "RTN","SDTMPHLA",224,0) Q "RTN","SDTMPHLA",225,0) CHKCLIN(X) ; check to see if this is a primary or secondary stop code for a tele health clinic "RTN","SDTMPHLA",226,0) I $G(X)'>0 S STOP=0 Q "RTN","SDTMPHLA",227,0) S STOP=0 "RTN","SDTMPHLA",228,0) N TEST,I,CODE,X1,X2 "RTN","SDTMPHLA",229,0) S X2=0 "RTN","SDTMPHLA",230,0) S X1=$$GET1^DIQ(40.7,X_",",1,"I"),X2=$O(^SD(40.6,"B",X1,"")) "RTN","SDTMPHLA",231,0) S:$G(X2)>0 STOP=1 "RTN","SDTMPHLA",232,0) Q STOP "RTN","SDTMPHLA",233,0) STATUS(X) ; a $Select to convert code to text too many characters in a single line. returns the text version of the appointment code "RTN","SDTMPHLA",234,0) S X1="" "RTN","SDTMPHLA",235,0) Q:$G(X)="" "RTN","SDTMPHLA",236,0) S:X="N" X1="NO-SHOW" "RTN","SDTMPHLA",237,0) S:X="C" X1="CANCELLED BY CLINIC" "RTN","SDTMPHLA",238,0) S:X="NA" X1="NO&AUTO RE-BOOK" "RTN","SDTMPHLA",239,0) S:X="CA" X1="CANCELLED BY CLINIC & AUTO RE-BOOK" "RTN","SDTMPHLA",240,0) S:X="I" X1="INPATIENT APPOINTMENT" "RTN","SDTMPHLA",241,0) S:X="PC" X1="CANCELLED BY PATIENT" "RTN","SDTMPHLA",242,0) S:X="PCA" X1="CANCELLED BY PATIENT & AUTO-REBOOK" "RTN","SDTMPHLA",243,0) S:X="NT" X1="NO ACTION TAKEN" "RTN","SDTMPHLA",244,0) S:X="S" X1="SCHEDULED" "RTN","SDTMPHLA",245,0) Q X1 "RTN","SDTMPHLA",246,0) EDIT406 ; Add/edit the stop code entries in file 40.6 "RTN","SDTMPHLA",247,0) N Y,X,STOPCODE,X1,GOOD,TMPERR "RTN","SDTMPHLA",248,0) S GOOD=0,X1=0,DEL="" "RTN","SDTMPHLA",249,0) K DIR(0),DIR("A"),DIR("?"),DIRUT,DUOUT,DTOUT,DIROUT,DIR("B") "RTN","SDTMPHLA",250,0) S DIR(0)="N",DIR("A")="Enter Stop Code" "RTN","SDTMPHLA",251,0) S DIR("?")="This is the stop code to added or deleted" "RTN","SDTMPHLA",252,0) D ^DIR K DIR S STOPCODE=Y G:$D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT)) EXIT "RTN","SDTMPHLA",253,0) S GOOD=$$CHKSTOP(STOPCODE) ;check to see if valid stop code in 40.7, message to user and quit if not valid "RTN","SDTMPHLA",254,0) I GOOD'>0 S TEXT="NOT A VALID STOP CODE" D MSG(TEXT) Q ; Need to add code to give user an error message "RTN","SDTMPHLA",255,0) S X1=$O(^SD(40.6,"B",STOPCODE,"")) "RTN","SDTMPHLA",256,0) D:X1>0 ASKDEL "RTN","SDTMPHLA",257,0) D:$G(DEL)="0" MSG("Do you want to edit another stop code") "RTN","SDTMPHLA",258,0) D UPD(DEL,STOPCODE) "RTN","SDTMPHLA",259,0) S TEXT=$G(TMPERR) "RTN","SDTMPHLA",260,0) D MSG("Do you want to edit another stop code") "RTN","SDTMPHLA",261,0) Q "RTN","SDTMPHLA",262,0) UPD(DEL,STOPCODE) ; "RTN","SDTMPHLA",263,0) N FDA "RTN","SDTMPHLA",264,0) I DEL="1" S FDA(40.6,X1_",",.01)="@" "RTN","SDTMPHLA",265,0) E S FDA(40.6,"+1,",.01)=STOPCODE "RTN","SDTMPHLA",266,0) D UPDATE^DIE("","FDA","TMPERR") "RTN","SDTMPHLA",267,0) Q "RTN","SDTMPHLA",268,0) ASKDEL ; "RTN","SDTMPHLA",269,0) D EX1 "RTN","SDTMPHLA",270,0) S DIR(0)="Y",DIR("A")="This stop code is already in the file, do you want to delete it",DIR("B")="NO" "RTN","SDTMPHLA",271,0) D ^DIR K DIR S DEL=Y G:$D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT)) EXIT "RTN","SDTMPHLA",272,0) Q "RTN","SDTMPHLA",273,0) CHKSTOP(STOPCODE) ; "RTN","SDTMPHLA",274,0) N XX "RTN","SDTMPHLA",275,0) S XX=$O(^DIC(40.7,"C",STOPCODE,"")) ; check to be sure it is valid stop code "RTN","SDTMPHLA",276,0) Q XX "RTN","SDTMPHLA",277,0) EX1 ; "RTN","SDTMPHLA",278,0) K DIR(0),DIR("A"),DIR("?"),DIRUT,DUOUT,DTOUT,DIROUT,X,Y "RTN","SDTMPHLA",279,0) Q "RTN","SDTMPHLA",280,0) EXIT ; "RTN","SDTMPHLA",281,0) K DIR(0),DIR("A"),DIR("?"),DIRUT,DUOUT,DTOUT,DIROUT,X,X1,Y,STOPCODE "RTN","SDTMPHLA",282,0) Q "RTN","SDTMPHLA",283,0) MSG(TEXT) ; give user error message if stop code is not valid "RTN","SDTMPHLA",284,0) D EX1 "RTN","SDTMPHLA",285,0) S DIR(0)="Y",DIR("A")=$G(TEXT) ;,DIR("A")="Do you want to edit another stop code" "RTN","SDTMPHLA",286,0) S DIR("B")="NO" D ^DIR "RTN","SDTMPHLA",287,0) G:$G(Y)=0 EXIT "RTN","SDTMPHLA",288,0) G:$G(Y)=1 EDIT406 "RTN","SDTMPHLA",289,0) Q "RTN","SDTMPHLB") 0^12^B46065382^n/a "RTN","SDTMPHLB",1,0) SDTMPHLB ;MS/PB - TMP HL7 Routine;MAY 29, 2018 "RTN","SDTMPHLB",2,0) ;;5.3;Scheduling;**704**;May 29, 2018;Build 64 "RTN","SDTMPHLB",3,0) Q "RTN","SDTMPHLB",4,0) EN(CLINID) ; Entry to the routine to build an HL7 message "RTN","SDTMPHLB",5,0) ;notification to TMP about a new appointment in a TeleHealth Clinic "RTN","SDTMPHLB",6,0) ;put in check for this to be a telehealth clinic. if not a telehealth clinic quit "RTN","SDTMPHLB",7,0) ;Call API to create MSH segment "RTN","SDTMPHLB",8,0) ; "RTN","SDTMPHLB",9,0) ;need to parse data from the file based on clinic, need to get VISN, overbooks and clinic status and privileged users "RTN","SDTMPHLB",10,0) ;default provider and default provider email. "RTN","SDTMPHLB",11,0) N STOP,SSTOP,PSTOP,MSG,RTN,UPDTTM "RTN","SDTMPHLB",12,0) S PSTOP=$P(^SC(CLINID,0),"^",7),SSTOP=$P(^SC(CLINID,0),"^",18) "RTN","SDTMPHLB",13,0) I ($G(PSTOP)=""&($G(SSTOP)="")) Q 0 ;if both PSTOP and SSTOP are null, the clinic is not a tele health clinic so quit "RTN","SDTMPHLB",14,0) S:$G(PSTOP)'="" STOP=$$CHKCLIN^SDTMPHLA($G(PSTOP)) ;if STOP=0, primary stop code is not a tele health stop code so check secondary stop code to see if it is a tele health clinic "RTN","SDTMPHLB",15,0) I $G(STOP)=0,($$CHKCLIN^SDTMPHLA($G(SSTOP))="") Q ;if primary stop code is not tele health check secondary stop code if secondary not tele health stop "RTN","SDTMPHLB",16,0) Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic "RTN","SDTMPHLB",17,0) N PARMS,SEG,WHOTO,ERROR,SEQ "RTN","SDTMPHLB",18,0) S PARMS("MESSAGE TYPE")="MFN",PARMS("EVENT")="M05" "RTN","SDTMPHLB",19,0) I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) W !,"ERR= "_$G(ERROR) Q 0 "RTN","SDTMPHLB",20,0) S SEQ=1 "RTN","SDTMPHLB",21,0) N % D NOW^%DTC S UPDTTM=$$TMCONV^SDTMPHLA(%) ; need to convert to HL7 in UTC "RTN","SDTMPHLB",22,0) K CLIN,IEN S IEN=CLINID_"," D CLINDATA(IEN) "RTN","SDTMPHLB",23,0) D MFI(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",24,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) W !,"NOT ADDED "_$G(ERROR)_" " Q 0 "RTN","SDTMPHLB",25,0) D MFE(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",26,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",27,0) D LOC(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",28,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",29,0) D NTE(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",30,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",31,0) D LDP(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",32,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",33,0) D ZDP(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",34,0) I $D(SEG),'$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",35,0) D ZPU(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",36,0) S PARMS("SENDING APPLICATION")="TMP_OUT" "RTN","SDTMPHLB",37,0) S WHOTO("RECEIVING APPLICATION")="TMP VIMT" "RTN","SDTMPHLB",38,0) S WHOTO("FACILITY LINK NAME")="TMP_SEND" "RTN","SDTMPHLB",39,0) S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0)) "RTN","SDTMPHLB",40,0) S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR) "RTN","SDTMPHLB",41,0) K CLINID,LOC "RTN","SDTMPHLB",42,0) Q RTN "RTN","SDTMPHLB",43,0) MFI(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",44,0) N APPID "RTN","SDTMPHLB",45,0) D SET^HLOAPI(.SEG,"MFI",0) ; Set the segment type "RTN","SDTMPHLB",46,0) ;D SET^HLOAPI(.SEG,"MFI",0) ; Set segment type to MFI "RTN","SDTMPHLB",47,0) D SET^HLOAPI(.SEG,CLINID,1) ; Set CLINIC ID "RTN","SDTMPHLB",48,0) S APPID="44^HOSPITAL LOCATION" "RTN","SDTMPHLB",49,0) D SET^HLOAPI(.SEG,APPID,2) ; File to be updated "RTN","SDTMPHLB",50,0) D SET^HLOAPI(.SEG,"UPD",3) ; Hard set as an UPD to the file -- Need code to determine if new or update "RTN","SDTMPHLB",51,0) D SET^HLOAPI(.SEG,UPDTTM,4) ; date/time the update occurred "RTN","SDTMPHLB",52,0) D SET^HLOAPI(.SEG,UPDTTM,5) ; effective date/time "RTN","SDTMPHLB",53,0) D SET^HLOAPI(.SEG,"AL",6) ; response level code, this is set to AL for ALWAYS "RTN","SDTMPHLB",54,0) Q "RTN","SDTMPHLB",55,0) MFE(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",56,0) N TYPE "RTN","SDTMPHLB",57,0) D SET^HLOAPI(.SEG,"MFE",0) ; Set the segment type "RTN","SDTMPHLB",58,0) S TYPE="MUP" ; this will be MAD for adding a new clinic, MUP for an update, MDS do deactivate and MAC for reactivate "RTN","SDTMPHLB",59,0) D SET^HLOAPI(.SEG,TYPE,1) ; type of action "RTN","SDTMPHLB",60,0) D SET^HLOAPI(.SEG,CLINID,2) ; Clinic IEN from the Hospital Location file "RTN","SDTMPHLB",61,0) D SET^HLOAPI(.SEG,UPDTTM,3) "RTN","SDTMPHLB",62,0) D SET^HLOAPI(.SEG,CLINID,4) "RTN","SDTMPHLB",63,0) D SET^HLOAPI(.SEG,"CE",5) ; Primary key value type, this will always be CE "RTN","SDTMPHLB",64,0) Q "RTN","SDTMPHLB",65,0) LOC(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",66,0) N INSTNUM,VISN,STATNUM,CLINNM "RTN","SDTMPHLB",67,0) K LOC "RTN","SDTMPHLB",68,0) S CLINNM=CLIN(44,CLINID_",",.01,"E"),STATNUM=$G(CLIN(44,CLINID_",",3,"I")) "RTN","SDTMPHLB",69,0) D SET^HLOAPI(.SEG,"LOC",0) ; Set the segment type "RTN","SDTMPHLB",70,0) D SET^HLOAPI(.SEG,CLINID,1) ; IEN from the Hospital Location file "RTN","SDTMPHLB",71,0) D SET^HLOAPI(.SEG,CLINNM,2) ; .01 from the Hospital Location file for the clinic "RTN","SDTMPHLB",72,0) D SET^HLOAPI(.SEG,"C",3) ; location type, this will always be C for clinic "RTN","SDTMPHLB",73,0) S INSTNUM=$$KSP^XUPARAM("INST") "RTN","SDTMPHLB",74,0) S VISN=$$VISN(INSTNUM) S:$G(VISN)'>0 VISN=0 ; Makes the assumption that a medical center only has one Parent Facility in the Institution file "RTN","SDTMPHLB",75,0) ; Need to change how LOC is used to set the data on the LOC segment. this is causing problems "RTN","SDTMPHLB",76,0) S LOC=$G(CLINNM)_"^"_INSTNUM_"^^^"_$G(VISN)_"^"_$G(STATNUM) "RTN","SDTMPHLB",77,0) D SET^HLOAPI(.SEG,$G(CLINNM),4,1) ; Clinic name "RTN","SDTMPHLB",78,0) D SET^HLOAPI(.SEG,$G(INSTNUM),4,2) ; institution number "RTN","SDTMPHLB",79,0) D SET^HLOAPI(.SEG,$G(VISN),4,5) ; visn "RTN","SDTMPHLB",80,0) D SET^HLOAPI(.SEG,$G(STATNUM),4,6) ; station number "RTN","SDTMPHLB",81,0) Q "RTN","SDTMPHLB",82,0) NTE(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",83,0) ;only one NTE per message. has the clinic start time and number of overbooks per day "RTN","SDTMPHLB",84,0) N CLINSTRT,OVERBK "RTN","SDTMPHLB",85,0) S CLINSTRT=CLIN(44,CLINID_",",1914,"E"),OVERBK=CLIN(44,CLINID_",",1918,"E") "RTN","SDTMPHLB",86,0) D SET^HLOAPI(.SEG,"NTE",0) "RTN","SDTMPHLB",87,0) D SET^HLOAPI(.SEG,1,1) "RTN","SDTMPHLB",88,0) D SET^HLOAPI(.SEG,$G(CLINSTRT),2) "RTN","SDTMPHLB",89,0) D SET^HLOAPI(.SEG,$G(OVERBK),3) "RTN","SDTMPHLB",90,0) Q "RTN","SDTMPHLB",91,0) LDP(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",92,0) W !,"LDP" "RTN","SDTMPHLB",93,0) N LS,TSPEC,PSTOP,SSTOP,PSNM,CSNM,ACT "RTN","SDTMPHLB",94,0) D ACT "RTN","SDTMPHLB",95,0) S LS=CLIN(44,CLINID_",",9,"E") "RTN","SDTMPHLB",96,0) S TSPEC=CLIN(44,CLINID_",",9.5,"E") "RTN","SDTMPHLB",97,0) S PSTOP=CLIN(44,CLINID_",",8,"I"),SSTOP=CLIN(44,CLINID_",",2503,"I"),PSNM=CLIN(44,CLINID_",",8,"E"),CSNM=CLIN(44,CLINID_",",2503,"E") "RTN","SDTMPHLB",98,0) S:$G(PSTOP)>0 PSTOP=$$GET1^DIQ(40.7,PSTOP_",",1,"I") "RTN","SDTMPHLB",99,0) S:$G(SSTOP)>0 SSTOP=$$GET1^DIQ(40.7,SSTOP_",",1,"I") "RTN","SDTMPHLB",100,0) D SET^HLOAPI(.SEG,"LDP",0) "RTN","SDTMPHLB",101,0) D SET^HLOAPI(.SEG,CLINID,1) "RTN","SDTMPHLB",102,0) ;NEED TO CHANGE THE SEGMENT FIELD SET BELOW TO SET INTO THE SUB FIELDS CORRECTLY "RTN","SDTMPHLB",103,0) D SET^HLOAPI(.SEG,LOC,2) "RTN","SDTMPHLB",104,0) D SET^HLOAPI(.SEG,$G(LS),3) "RTN","SDTMPHLB",105,0) D SET^HLOAPI(.SEG,$G(TSPEC),4) "RTN","SDTMPHLB",106,0) D SET^HLOAPI(.SEG,$G(ACT),6) "RTN","SDTMPHLB",107,0) D SET^HLOAPI(.SEG,$G(ACTDT),7) ; reactivation date "RTN","SDTMPHLB",108,0) D SET^HLOAPI(.SEG,$G(INACTDT),8) ; inactivation date "RTN","SDTMPHLB",109,0) D SET^HLOAPI(.SEG,"UNK",9) "RTN","SDTMPHLB",110,0) ; change the line below to use HLO to set up the field and sub fields don't do manually "RTN","SDTMPHLB",111,0) D SET^HLOAPI(.SEG,$G(PSTOP)_"^"_$G(PSNM)_"^CLINIC STOP^"_$G(SSTOP)_"^"_$G(CSNM),12) ;STOP CODES "RTN","SDTMPHLB",112,0) Q "RTN","SDTMPHLB",113,0) ZPU(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",114,0) N XX,SEQA "RTN","SDTMPHLB",115,0) ; Need code to loop thru the privileged users and add a segment for each privileged user "RTN","SDTMPHLB",116,0) S XX=0,SEQA=1 F S XX=$O(^SC(CLINID,"SDPRIV",XX)) Q:XX'>0 D "RTN","SDTMPHLB",117,0) .N CIEN S CIEN=+$P(^SC(CLINID,"SDPRIV",XX,0),"^") "RTN","SDTMPHLB",118,0) .Q:$G(CIEN)'>0 "RTN","SDTMPHLB",119,0) .N CLERKNM,CLERKEMAIL,CVPID "RTN","SDTMPHLB",120,0) .S CLERKNM=$$GET1^DIQ(200,CIEN_",",.01,"E"),CLERKEMAIL=$$GET1^DIQ(200,CIEN_",",.151,"E"),CVPID=$$GET1^DIQ(200,CIEN_",",9000,"I") "RTN","SDTMPHLB",121,0) .I $G(CLERKNM)'="",$G(CLERKEMAIL)="" S CLERKEMAIL="UNK" "RTN","SDTMPHLB",122,0) .S:$G(CVPID)="" CVPID="0" "RTN","SDTMPHLB",123,0) .D SET^HLOAPI(.SEG,"ZPU",0) "RTN","SDTMPHLB",124,0) .D SET^HLOAPI(.SEG,SEQA,1) "RTN","SDTMPHLB",125,0) .D SET^HLOAPI(.SEG,CLERKNM,2) "RTN","SDTMPHLB",126,0) .D SET^HLOAPI(.SEG,CLERKEMAIL,3) "RTN","SDTMPHLB",127,0) .D SET^HLOAPI(.SEG,CVPID,4) "RTN","SDTMPHLB",128,0) .S SEQA=$G(SEQA)+1 "RTN","SDTMPHLB",129,0) .I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q "RTN","SDTMPHLB",130,0) Q "RTN","SDTMPHLB",131,0) ZDP(CLINID,SEQ,SEG) ; has the default provider duz, default provider name and default provider email "RTN","SDTMPHLB",132,0) ;default provider duz comes from the Clinic in file 44. provider name and email from file 2 "RTN","SDTMPHLB",133,0) K PROVDUZ,PROVNM,PROVEMAIL,VPID "RTN","SDTMPHLB",134,0) ;S PROVNM="BURKHALTER,PHIL",PROVEMAIL="phil.burkhalter@anymail.com",VPID="123245V123" "RTN","SDTMPHLB",135,0) S PROVDUZ=CLIN(44,CLINID_",",16,"I"),PROVNM=CLIN(44,CLINID_",",16,"E") "RTN","SDTMPHLB",136,0) S PROVEMAIL="",VPID="" "RTN","SDTMPHLB",137,0) I $G(PROVDUZ)>0 S PROVEMAIL=$$GET1^DIQ(200,PROVDUZ_",",.151,"E","SDTMPERR"),VPID=$$GET1^DIQ(200,PROVDUZ_",",9000,"I","SDTMPERR") "RTN","SDTMPHLB",138,0) S:$G(PROVEMAIL)="" PROVEMAIL="UNK" "RTN","SDTMPHLB",139,0) S:$G(VPID)="" VPID="0" "RTN","SDTMPHLB",140,0) D SET^HLOAPI(.SEG,"ZDP",0) "RTN","SDTMPHLB",141,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLB",142,0) D SET^HLOAPI(.SEG,$G(PROVNM),2) "RTN","SDTMPHLB",143,0) D SET^HLOAPI(.SEG,$G(PROVEMAIL),3) "RTN","SDTMPHLB",144,0) D SET^HLOAPI(.SEG,$G(VPID),4) "RTN","SDTMPHLB",145,0) K PROVNM,PROVEMAIL,VPID "RTN","SDTMPHLB",146,0) Q "RTN","SDTMPHLB",147,0) CLINDATA(CLINID) ; get the clinic data, add code to pull the data from file 44 and 200 "RTN","SDTMPHLB",148,0) N FLDS "RTN","SDTMPHLB",149,0) Q:$G(CLINID)'>0 "RTN","SDTMPHLB",150,0) S IEN=CLINID_",",FLDS=".01;3;8;9;9.5;16;1914;1918;2503;2505;2506" "RTN","SDTMPHLB",151,0) D GETS^DIQ(44,IEN,FLDS,"IE","CLIN","TMPERR") "RTN","SDTMPHLB",152,0) Q "RTN","SDTMPHLB",153,0) VISN(INSTNUM) ; "RTN","SDTMPHLB",154,0) N IEN,VISNPTR "RTN","SDTMPHLB",155,0) S VISN=0 "RTN","SDTMPHLB",156,0) S IEN=$$IEN^XUAF4(INSTNUM) "RTN","SDTMPHLB",157,0) S:$G(IEN)>0 VISNPTR=$P(^DIC(4,IEN,7,1,0),"^",2) "RTN","SDTMPHLB",158,0) I $G(VISNPTR)>0 D "RTN","SDTMPHLB",159,0) .S VISN=$P($G(^DIC(4,VISNPTR,0)),"^",1) "RTN","SDTMPHLB",160,0) .S VISN=$P(VISN," ",2) "RTN","SDTMPHLB",161,0) Q VISN "RTN","SDTMPHLB",162,0) ACT ; "RTN","SDTMPHLB",163,0) N INACTDT,ACTDT "RTN","SDTMPHLB",164,0) S INACTDT=CLIN(44,CLINID_",",2505,"I") "RTN","SDTMPHLB",165,0) I INACTDT="" S ACT="A" "RTN","SDTMPHLB",166,0) I INACTDT'="" D "RTN","SDTMPHLB",167,0) .S ACT="I" "RTN","SDTMPHLB",168,0) .S ACTDT=CLIN(44,CLINID_",",2506,"I") "RTN","SDTMPHLB",169,0) .I ACTDT>INACTDT S ACT="A" "RTN","SDTMPHLB",170,0) Q "SEC","^DIC",40.6,40.6,0,"AUDIT") @ "SEC","^DIC",40.6,40.6,0,"DD") @ "SEC","^DIC",40.6,40.6,0,"DEL") @ "SEC","^DIC",40.6,40.6,0,"LAYGO") @ "SEC","^DIC",40.6,40.6,0,"RD") @ "SEC","^DIC",40.6,40.6,0,"WR") @ "UP",2,2.98,-1) 2^S "UP",2,2.98,0) 2.98 "UP",44,44.003,-2) 44^S "UP",44,44.003,-1) 44.001^1 "UP",44,44.003,0) 44.003 "VER") 8.0^22.2 "^DD",2,2.98,29,0) SCHEDULING APPLICATION^FJ30^^1;3^K:$L(X)>30!($L(X)<1) X "^DD",2,2.98,29,3) Answer must be 1-30 characters in length. "^DD",2,2.98,29,21,0) ^^1^1^3181018^ "^DD",2,2.98,29,21,1,0) Name of the application that was used to schedule this appointment. "^DD",2,2.98,29,"DT") 3181018 "^DD",2,2.98,30,0) SCHEDULER NAME^FJ35^^1;4^K:$L(X)>35!($L(X)<3) X "^DD",2,2.98,30,3) Answer must be 3-35 characters in length. "^DD",2,2.98,30,21,0) ^^3^3^3181018^ "^DD",2,2.98,30,21,1,0) The name of the person who scheduled this appointment. This is mainly for "^DD",2,2.98,30,21,2,0) CCRA integration, as the CCRA user may not be an active user on the local "^DD",2,2.98,30,21,3,0) VistA system. "^DD",2,2.98,30,"DT") 3181018 "^DD",40.6,40.6,0) FIELD^^.01^1 "^DD",40.6,40.6,0,"DT") 3190718 "^DD",40.6,40.6,0,"IX","B",40.6,.01) "^DD",40.6,40.6,0,"NM","SD TELE HEALTH STOP CODE FILE") "^DD",40.6,40.6,0,"VRPK") SD "^DD",40.6,40.6,.01,0) STOP CODE NUMBER^RFJ9^^0;1^K:$L(X)>9!($L(X)<3)!'(X'?1P.E) X "^DD",40.6,40.6,.01,1,0) ^.1 "^DD",40.6,40.6,.01,1,1,0) 40.6^B "^DD",40.6,40.6,.01,1,1,1) S ^SD(40.6,"B",$E(X,1,30),DA)="" "^DD",40.6,40.6,.01,1,1,2) K ^SD(40.6,"B",$E(X,1,30),DA) "^DD",40.6,40.6,.01,3) Enter the 3 to 9 digit stop code number. "^DD",40.6,40.6,.01,21,0) ^^1^1^3190107^ "^DD",40.6,40.6,.01,21,1,0) This is the stop code number from the Clinic Stop File (#40.7). "^DD",40.6,40.6,.01,"DT") 3190107 "^DD",44,44.003,400,0) VETERAN VIDEO CALL URL^FJ200^^URL;1^K:$L(X)>200!($L(X)<3) X "^DD",44,44.003,400,3) Answer must be 3-200 characters in length. "^DD",44,44.003,400,"DT") 3181030 "^DIC",40.6,40.6,0) SD TELE HEALTH STOP CODE FILE^40.6 "^DIC",40.6,40.6,0,"GL") ^SD(40.6, "^DIC",40.6,40.6,"%",0) ^1.005^^0 "^DIC",40.6,40.6,"%D",0) ^^6^6^3190107^ "^DIC",40.6,40.6,"%D",1,0) This file stores the list of current tele health stop codes. The Tele "^DIC",40.6,40.6,"%D",2,0) Health Management Platform (TMP) uses this file to identify tele health "^DIC",40.6,40.6,"%D",3,0) clinics as part of the TMP real time updates. TMP is monitoring the "^DIC",40.6,40.6,"%D",4,0) Hospital Location File (#44) for edits to tele health clinics. These "^DIC",40.6,40.6,"%D",5,0) edits are sent to TMP in real time in order to keep TMP in sync with each "^DIC",40.6,40.6,"%D",6,0) VistA system. "^DIC",40.6,"B","SD TELE HEALTH STOP CODE FILE",40.6) "BLD",11394,6) ^588 **END** **END**