Released SD*5.3*773 SEQ #636 Extracted from mail message **KIDS**:SD*5.3*773^ **INSTALL NAME** SD*5.3*773 "BLD",11625,0) SD*5.3*773^SCHEDULING^0^3210415^y "BLD",11625,1,0) ^^2^2^3210304^^^ "BLD",11625,1,1,0) Time zone fixes, $Q error, and date format error in NEWTIME, TMP New SD "BLD",11625,1,2,0) Tools Menu and items. "BLD",11625,4,0) ^9.64PA^^ "BLD",11625,6.3) 9 "BLD",11625,"KRN",0) ^9.67PA^1.5^25 "BLD",11625,"KRN",.4,0) .4 "BLD",11625,"KRN",.401,0) .401 "BLD",11625,"KRN",.402,0) .402 "BLD",11625,"KRN",.403,0) .403 "BLD",11625,"KRN",.5,0) .5 "BLD",11625,"KRN",.84,0) .84 "BLD",11625,"KRN",1.5,0) 1.5 "BLD",11625,"KRN",1.6,0) 1.6 "BLD",11625,"KRN",1.61,0) 1.61 "BLD",11625,"KRN",1.62,0) 1.62 "BLD",11625,"KRN",3.6,0) 3.6 "BLD",11625,"KRN",3.8,0) 3.8 "BLD",11625,"KRN",9.2,0) 9.2 "BLD",11625,"KRN",9.8,0) 9.8 "BLD",11625,"KRN",9.8,"NM",0) ^9.68A^15^10 "BLD",11625,"KRN",9.8,"NM",6,0) SDTMPHLA^^0^B102974942 "BLD",11625,"KRN",9.8,"NM",7,0) SDTMPHLB^^0^B48918000 "BLD",11625,"KRN",9.8,"NM",8,0) SDTMPUT0^^0^B44563014 "BLD",11625,"KRN",9.8,"NM",9,0) SDTMPUT1^^0^B16907997 "BLD",11625,"KRN",9.8,"NM",10,0) SDHL7CON^^0^B103881672 "BLD",11625,"KRN",9.8,"NM",11,0) SDHLAPT2^^0^B11391953 "BLD",11625,"KRN",9.8,"NM",12,0) SDTMBUS^^0^B30397594 "BLD",11625,"KRN",9.8,"NM",13,0) SDHL7APU^^0^B259940586 "BLD",11625,"KRN",9.8,"NM",14,0) SDHL7APT^^0^B272704132 "BLD",11625,"KRN",9.8,"NM",15,0) SDTMPEDT^^0^B6966075 "BLD",11625,"KRN",9.8,"NM","B","SDHL7APT",14) "BLD",11625,"KRN",9.8,"NM","B","SDHL7APU",13) "BLD",11625,"KRN",9.8,"NM","B","SDHL7CON",10) "BLD",11625,"KRN",9.8,"NM","B","SDHLAPT2",11) "BLD",11625,"KRN",9.8,"NM","B","SDTMBUS",12) "BLD",11625,"KRN",9.8,"NM","B","SDTMPEDT",15) "BLD",11625,"KRN",9.8,"NM","B","SDTMPHLA",6) "BLD",11625,"KRN",9.8,"NM","B","SDTMPHLB",7) "BLD",11625,"KRN",9.8,"NM","B","SDTMPUT0",8) "BLD",11625,"KRN",9.8,"NM","B","SDTMPUT1",9) "BLD",11625,"KRN",19,0) 19 "BLD",11625,"KRN",19,"NM",0) ^9.68A^6^6 "BLD",11625,"KRN",19,"NM",1,0) SD TELE CLN UPDATE^^0 "BLD",11625,"KRN",19,"NM",2,0) SD TELE INQ^^0 "BLD",11625,"KRN",19,"NM",3,0) SD TELE STOP CODE^^0 "BLD",11625,"KRN",19,"NM",4,0) SD TELE TOOLS^^0 "BLD",11625,"KRN",19,"NM",5,0) SD EDIT TELE HEALTH STOP CODES^^1^ "BLD",11625,"KRN",19,"NM",6,0) SDSUP^^2 "BLD",11625,"KRN",19,"NM","B","SD EDIT TELE HEALTH STOP CODES",5) "BLD",11625,"KRN",19,"NM","B","SD TELE CLN UPDATE",1) "BLD",11625,"KRN",19,"NM","B","SD TELE INQ",2) "BLD",11625,"KRN",19,"NM","B","SD TELE STOP CODE",3) "BLD",11625,"KRN",19,"NM","B","SD TELE TOOLS",4) "BLD",11625,"KRN",19,"NM","B","SDSUP",6) "BLD",11625,"KRN",19.1,0) 19.1 "BLD",11625,"KRN",101,0) 101 "BLD",11625,"KRN",409.61,0) 409.61 "BLD",11625,"KRN",771,0) 771 "BLD",11625,"KRN",779.2,0) 779.2 "BLD",11625,"KRN",870,0) 870 "BLD",11625,"KRN",8989.51,0) 8989.51 "BLD",11625,"KRN",8989.52,0) 8989.52 "BLD",11625,"KRN",8993,0) 8993 "BLD",11625,"KRN",8994,0) 8994 "BLD",11625,"KRN","B",.4,.4) "BLD",11625,"KRN","B",.401,.401) "BLD",11625,"KRN","B",.402,.402) "BLD",11625,"KRN","B",.403,.403) "BLD",11625,"KRN","B",.5,.5) "BLD",11625,"KRN","B",.84,.84) "BLD",11625,"KRN","B",1.5,1.5) "BLD",11625,"KRN","B",1.6,1.6) "BLD",11625,"KRN","B",1.61,1.61) "BLD",11625,"KRN","B",1.62,1.62) "BLD",11625,"KRN","B",3.6,3.6) "BLD",11625,"KRN","B",3.8,3.8) "BLD",11625,"KRN","B",9.2,9.2) "BLD",11625,"KRN","B",9.8,9.8) "BLD",11625,"KRN","B",19,19) "BLD",11625,"KRN","B",19.1,19.1) "BLD",11625,"KRN","B",101,101) "BLD",11625,"KRN","B",409.61,409.61) "BLD",11625,"KRN","B",771,771) "BLD",11625,"KRN","B",779.2,779.2) "BLD",11625,"KRN","B",870,870) "BLD",11625,"KRN","B",8989.51,8989.51) "BLD",11625,"KRN","B",8989.52,8989.52) "BLD",11625,"KRN","B",8993,8993) "BLD",11625,"KRN","B",8994,8994) "BLD",11625,"QDEF") ^^^^NO^^^^YES^^NO "BLD",11625,"QUES",0) ^9.62^^ "BLD",11625,"REQB",0) ^9.611^1^1 "BLD",11625,"REQB",1,0) SD*5.3*754^1 "BLD",11625,"REQB","B","SD*5.3*754",1) "KRN",19,120,-1) 2^6 "KRN",19,120,0) SDSUP^Supervisor Menu^^M^432^^^^^^^16 "KRN",19,120,10,0) ^19.01IP^42^42 "KRN",19,120,10,41,0) 17854^^ "KRN",19,120,10,41,"^") SD TELE TOOLS "KRN",19,120,"U") SUPERVISOR MENU "KRN",19,17853,-1) 0^2 "KRN",19,17853,0) SD TELE INQ^Telehealth Inquiries^^R^^^^^^^^SCHEDULING^^ "KRN",19,17853,20) "KRN",19,17853,25) SDTMPUT0 "KRN",19,17853,668000,0) ^19.0668^1^1 "KRN",19,17853,668000,1,0) INQ "KRN",19,17853,"U") TELEHEALTH INQUIRIES "KRN",19,17854,-1) 0^4 "KRN",19,17854,0) SD TELE TOOLS^Telehealth Management Toolbox^^M^^^^^^^^ "KRN",19,17854,10,0) ^19.01IP^3^3 "KRN",19,17854,10,1,0) 17853^INQ^1 "KRN",19,17854,10,1,"^") SD TELE INQ "KRN",19,17854,10,2,0) 17855^ST^2 "KRN",19,17854,10,2,"^") SD TELE STOP CODE "KRN",19,17854,10,3,0) 17856^CLN "KRN",19,17854,10,3,"^") SD TELE CLN UPDATE "KRN",19,17854,99) 65798,33559 "KRN",19,17854,"U") TELEHEALTH MANAGEMENT TOOLBOX "KRN",19,17855,-1) 0^3 "KRN",19,17855,0) SD TELE STOP CODE^Telehealth Stop Code Add/Edit^^R^^^^^^^^ "KRN",19,17855,1,0) ^19.06^2^2^3210408^^^ "KRN",19,17855,1,1,0) This option provides users with the ability to add or delete stop codes "KRN",19,17855,1,2,0) used to identify tele health clinics. "KRN",19,17855,25) EDIT^SDTMPEDT "KRN",19,17855,668000,0) ^19.0668^1^1 "KRN",19,17855,668000,1,0) ST "KRN",19,17855,"U") TELEHEALTH STOP CODE ADD/EDIT "KRN",19,17856,-1) 0^1 "KRN",19,17856,0) SD TELE CLN UPDATE^VistA-Telehealth Clinic Update^^R^^^^^^^^ "KRN",19,17856,25) SDTMPUT1 "KRN",19,17856,"U") VISTA-TELEHEALTH CLINIC UPDATE "KRN",19,17862,-1) 1^5 "KRN",19,17862,0) SD EDIT TELE HEALTH STOP CODES "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "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^2930918 "PKG",16,22,1,"PAH",1,0) 773^3210415 "PKG",16,22,1,"PAH",1,1,0) ^^2^2^3210415 "PKG",16,22,1,"PAH",1,1,1,0) Time zone fixes, $Q error, and date format error in NEWTIME, TMP New SD "PKG",16,22,1,"PAH",1,1,2,0) Tools Menu and items. "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") YES "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") 10 "RTN","SDHL7APT") 0^14^B272704132^B272423848 "RTN","SDHL7APT",1,0) SDHL7APT ;MS/TG,PH - TMP HL7 Routine;AUG 17, 2018 "RTN","SDHL7APT",2,0) ;;5.3;Scheduling;**704,714,754,773**;AUG 17, 2018;Build 9 "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 APPTYPE,AILNTE,DFN,RET,CNT,PID,PV1,RGS,AIS,AIG,AISNTE,OVB,OFFSET,AIP,RTCID,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,EESTAT,GRPCNT,GRPNO,OBX,PREVSEG,PTIEN,SCHDFN,SCPERC,SDDDT,SDECATID,SDUSER,CHILD,MSAHDR,SDECTYP "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,SDECCR,INTRA,SDXRAY,SEGTYPE,INST,INSTIEN,FLMNFMT2,SDAPTYP,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) S MSAHDR="MSA^1^^100^AE^" "RTN","SDHL7APT",89,0) I +ERR D Q "RTN","SDHL7APT",90,0) .;S ERR="MSA^1^^100^AE^"_$E(ERRTXT,1,50) "RTN","SDHL7APT",91,0) .S ERR=$G(MSAHDR)_$E(ERRTXT,1,50) "RTN","SDHL7APT",92,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",93,0) .K @MSGROOT "RTN","SDHL7APT",94,0) .Q "RTN","SDHL7APT",95,0) ; "RTN","SDHL7APT",96,0) K SCHNW,INP,PCE,SCPER,ATYPIEN "RTN","SDHL7APT",97,0) ; "RTN","SDHL7APT",98,0) ; Loop to populate MSGARY, INP arrays which are used in ^SDECAR2 (to create appt request) and ^SDEC07 (to create appt) "RTN","SDHL7APT",99,0) N MSGARY,SDCL2,SDCL3 "RTN","SDHL7APT",100,0) D MSH^SDHL7APU(.MSH,.INP,.MSGARY) "RTN","SDHL7APT",101,0) D SCH^SDHL7APU(.SCH,.INP,.MSGARY) "RTN","SDHL7APT",102,0) D SCHNTE^SDHL7APU(.SCHNTE,.INP,.MSGARY) "RTN","SDHL7APT",103,0) D PID^SDHL7APU(.PID,.INP,.MSGARY) "RTN","SDHL7APT",104,0) D PV1^SDHL7APU(.PV1,.INP,.MSGARY) "RTN","SDHL7APT",105,0) D OBX^SDHL7APU(.OBX,.INP) "RTN","SDHL7APT",106,0) F IX=1:1:GRPCNT D "RTN","SDHL7APT",107,0) .D RGS^SDHL7APU(.RGS,IX,.INP) "RTN","SDHL7APT",108,0) .D AIS^SDHL7APU(.AIS,IX,.INP,.MSGARY) "RTN","SDHL7APT",109,0) .D AISNTE^SDHL7APU(.AISNTE,IX,.INP) "RTN","SDHL7APT",110,0) .D AIG^SDHL7APU(.AIG,IX,.INP) "RTN","SDHL7APT",111,0) .D AIGNTE^SDHL7APU(.AIGNTE,IX,.INP) "RTN","SDHL7APT",112,0) .D AIL^SDHL7APU(.AIL,IX,.INP,.MSGARY) "RTN","SDHL7APT",113,0) .D AILNTE^SDHL7APU(.AILNTE,IX,.INP) "RTN","SDHL7APT",114,0) .D AIP^SDHL7APU(.AIP,IX,.INP,.MSGARY) "RTN","SDHL7APT",115,0) .D AIPNTE^SDHL7APU(.AIPNTE,IX,.INP) "RTN","SDHL7APT",116,0) .Q "RTN","SDHL7APT",117,0) N %,NOW "RTN","SDHL7APT",118,0) D NOW^%DTC S CURDTTM=$$TMCONV^SDTMPHLA(%,$$KSP^XUPARAM("INST")) ;773 "RTN","SDHL7APT",119,0) S NOW=$$HTFM^XLFDT($H),INP(3)=$$FMTE^XLFDT(NOW) "RTN","SDHL7APT",120,0) S INP(11)=INP(3) "RTN","SDHL7APT",121,0) S INP(5)="APPT" "RTN","SDHL7APT",122,0) S INP(8)="FUTURE" "RTN","SDHL7APT",123,0) ; "RTN","SDHL7APT",124,0) N X11 S X11=$P($G(SDAPTYP),"|") S:$G(X11)="" X11="A" "RTN","SDHL7APT",125,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",126,0) ; "RTN","SDHL7APT",127,0) K DFN "RTN","SDHL7APT",128,0) S (DFN,INP(2))=$$GETDFN^MPIF001(MSGARY("MPI")) "RTN","SDHL7APT",129,0) I $P(DFN,U,2)="NO ICN"!($P(DFN,U,2)="ICN NOT IN DATABASE") D Q "RTN","SDHL7APT",130,0) .;S ERR="MSA^1^^100^AE^PATIENT ICN NOT FOUND" "RTN","SDHL7APT",131,0) .S ERR=$G(MSAHDR)_"PATIENT ICN NOT FOUND" "RTN","SDHL7APT",132,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",133,0) .K @MSGROOT "RTN","SDHL7APT",134,0) .Q "RTN","SDHL7APT",135,0) ; "RTN","SDHL7APT",136,0) N STOPME "RTN","SDHL7APT",137,0) I $P($G(SDAPTYP),"|",1)="C"!($P($G(SDAPTYP),"|",1)="R") D CHKCON^SDHLAPT2(DFN,SDAPTYP) I $G(STOPME)=1 Q "RTN","SDHL7APT",138,0) ; "RTN","SDHL7APT",139,0) I $G(SDCL)="" D Q "RTN","SDHL7APT",140,0) .;S ERR="MSA^1^^100^AE^CLINIC ID IS NULL",STOPME=1 "RTN","SDHL7APT",141,0) .S ERR=$G(MSAHDR)_"CLINIC ID IS NULL",STOPME=1 "RTN","SDHL7APT",142,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",143,0) .K @MSGROOT "RTN","SDHL7APT",144,0) .Q "RTN","SDHL7APT",145,0) ; "RTN","SDHL7APT",146,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",147,0) ; "RTN","SDHL7APT",148,0) I '$D(^SC($G(SDCL),0)) D Q "RTN","SDHL7APT",149,0) .Q:$G(AIL(1,3,1,4))'=$P(^DIC(4,$$KSP^XUPARAM("INST"),99),"^") "RTN","SDHL7APT",150,0) .;S ERR="MSA^1^^100^AE^NOT A CLINIC AT THIS SITE "_$G(SDCL) "RTN","SDHL7APT",151,0) .S ERR=$G(MSAHDR)_"NOT A CLINIC AT THIS SITE "_$G(SDCL) "RTN","SDHL7APT",152,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",153,0) .K @MSGROOT "RTN","SDHL7APT",154,0) .Q "RTN","SDHL7APT",155,0) ; "RTN","SDHL7APT",156,0) S STOPME=0 "RTN","SDHL7APT",157,0) I $G(SDCL2)>0 D "RTN","SDHL7APT",158,0) .Q:$G(AIL(2,3,1,4))'=$P(^DIC(4,$$KSP^XUPARAM("INST"),99),"^") "RTN","SDHL7APT",159,0) .;I '$D(^SC($G(SDCL2),0)) S ERR="MSA^1^^100^AE^NOT A CLINIC AT THIS SITE "_$G(SDCL2),STOPME=1 D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",160,0) .I '$D(^SC($G(SDCL2),0)) S ERR=$G(MSAHDR)_"NOT A CLINIC AT THIS SITE "_$G(SDCL2),STOPME=1 D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",161,0) .K @MSGROOT "RTN","SDHL7APT",162,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",163,0) K INP D INP^SDHL7APU "RTN","SDHL7APT",164,0) ; "RTN","SDHL7APT",165,0) S RET="" "RTN","SDHL7APT",166,0) ;IF a regular appt, not rtc or consult check to see if the appointment is in 409.85 "RTN","SDHL7APT",167,0) I $P(SDAPTYP,"|",1)="A" D "RTN","SDHL7APT",168,0) .Q:$$UPPER^SDUL1(MSGARY("HL7EVENT"))'="S12" "RTN","SDHL7APT",169,0) .S:INP(3)="" INP(3)=DT S RTN=0 D ARSET^SDHLAPT1(.RTN,.INP) S:$P($G(RTN),U,2) SDAPTYP="A|"_$P($G(RTN),U,2) "RTN","SDHL7APT",170,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",171,0) ;714 - PB get the division associated with the clinic and pass to the function to convert utc to local time "RTN","SDHL7APT",172,0) N TMPSTART,D1,D2 "RTN","SDHL7APT",173,0) S:$G(SDCL)>0 D1=$P(^SC(SDCL,0),"^",15),D2=$$GET1^DIQ(40.8,D1_",",.07,"I") "RTN","SDHL7APT",174,0) S FLMNFMT=$$JSONTFM^SDHLAPT2(SDECSTART,D2),TMPSTART=FLMNFMT,SDECSTART=$$FMTE^XLFDT(FLMNFMT) "RTN","SDHL7APT",175,0) I FLMNFMT<1 D Q "RTN","SDHL7APT",176,0) .S ERR=$G(MSAHDR)_"Invalid Start Date sent" "RTN","SDHL7APT",177,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",178,0) .K @MSGROOT "RTN","SDHL7APT",179,0) .Q "RTN","SDHL7APT",180,0) ; "RTN","SDHL7APT",181,0) ;PB - 714 fix to stop duplicate appointments for the patient "RTN","SDHL7APT",182,0) S STOPME=0 "RTN","SDHL7APT",183,0) I $G(^DPT(DFN,"S",FLMNFMT,0))&($G(MSGARY("HL7EVENT"))="S12") D "RTN","SDHL7APT",184,0) .Q:$P($G(^DPT(DFN,"S",FLMNFMT,0)),"^",2)["C" "RTN","SDHL7APT",185,0) .S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT),STOPME=1 "RTN","SDHL7APT",186,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",187,0) .K @MSGROOT "RTN","SDHL7APT",188,0) .Q "RTN","SDHL7APT",189,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",190,0) S STOPME=0 "RTN","SDHL7APT",191,0) I $G(INTRA)=1 D "RTN","SDHL7APT",192,0) .S FLMNFMT2=$$FMADD^XLFDT(FLMNFMT,,,5) "RTN","SDHL7APT",193,0) .Q:$G(MSGARY("HL7EVENT"))'="S12" "RTN","SDHL7APT",194,0) .I $D(^DPT(DFN,"S",FLMNFMT,0)) D "RTN","SDHL7APT",195,0) ..I $P($G(^DPT(DFN,"S",FLMNFMT,0)),"^",2)'["C" D "RTN","SDHL7APT",196,0) ...S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT2),STOPME=1 "RTN","SDHL7APT",197,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",198,0) ...K @MSGROOT "RTN","SDHL7APT",199,0) .Q:$G(STOPME)=1 "RTN","SDHL7APT",200,0) .I $D(^DPT(DFN,"S",FLMNFMT2,0)) D "RTN","SDHL7APT",201,0) ..I $P($G(^DPT(DFN,"S",FLMNFMT2,0)),"^",2)'["C" D "RTN","SDHL7APT",202,0) ...S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT2),STOPME=1 "RTN","SDHL7APT",203,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",204,0) ...K @MSGROOT "RTN","SDHL7APT",205,0) .Q "RTN","SDHL7APT",206,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",207,0) I $L(SDECLEN),$L($G(SCH(10))) D "RTN","SDHL7APT",208,0) .I $G(SCH(10))="MIN" S SDECEND=$$FMADD^XLFDT(FLMNFMT,,,$G(SDECLEN)) "RTN","SDHL7APT",209,0) .I $G(SCH(10))="HR" S SDECEND=$$FMADD^XLFDT(FLMNFMT,,$G(SDECLEN)) "RTN","SDHL7APT",210,0) .Q "RTN","SDHL7APT",211,0) ; "RTN","SDHL7APT",212,0) N TMPARR,LEN "RTN","SDHL7APT",213,0) S LEN=0,ERRSND=0,ERRTXT="",MSGROOT="SDTMPHL" "RTN","SDHL7APT",214,0) K @MSGROOT "RTN","SDHL7APT",215,0) ; Loop to send RGS>1 groups to remote facilities. Abort entire SIU if any facility returns AE from remote. "RTN","SDHL7APT",216,0) ;N INTRA "RTN","SDHL7APT",217,0) F GRPNO=2:1:GRPCNT D Q:+ERRSND "RTN","SDHL7APT",218,0) .K @MSGROOT "RTN","SDHL7APT",219,0) .S CNT=1,INTRA=0 "RTN","SDHL7APT",220,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",221,0) .I $D(SCHNTE) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.SCHNTE,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",222,0) .I $D(PID) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PID,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",223,0) .I $D(PV1) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PV1,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",224,0) .M TMPARR=RGS(GRPNO) "RTN","SDHL7APT",225,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",226,0) .K TMPARR "RTN","SDHL7APT",227,0) .M TMPARR=AIS(GRPNO) "RTN","SDHL7APT",228,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",229,0) .K TMPARR "RTN","SDHL7APT",230,0) .M TMPARR=AISNTE(GRPNO) "RTN","SDHL7APT",231,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",232,0) .K TMPARR "RTN","SDHL7APT",233,0) .M TMPARR=AIG(GRPNO) "RTN","SDHL7APT",234,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",235,0) .K TMPARR "RTN","SDHL7APT",236,0) .M TMPARR=AIL(GRPNO) "RTN","SDHL7APT",237,0) .I $D(TMPARR) D "RTN","SDHL7APT",238,0) ..S INSTIEN=$G(TMPARR(3,1,4)) "RTN","SDHL7APT",239,0) ..S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",240,0) .K TMPARR "RTN","SDHL7APT",241,0) .M TMPARR=AILNTE(GRPNO) "RTN","SDHL7APT",242,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",243,0) .K TMPARR "RTN","SDHL7APT",244,0) .M TMPARR=AIP(GRPNO) "RTN","SDHL7APT",245,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",246,0) .K TMPARR "RTN","SDHL7APT",247,0) .M TMPARR=AIPNTE(GRPNO) "RTN","SDHL7APT",248,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",249,0) .K TMPARR "RTN","SDHL7APT",250,0) .S:$G(AIL(1,3,1,4))=$G(AIL(2,3,1,4)) INTRA=1 "RTN","SDHL7APT",251,0) .I $G(INTRA)=1 D NEWTIME^SDHLAPT2 "RTN","SDHL7APT",252,0) .N HLRESLT,X "RTN","SDHL7APT",253,0) .I $G(INTRA)=0 D "RTN","SDHL7APT",254,0) ..I '$$CHKLL^HLUTIL($G(INSTIEN)) D Q "RTN","SDHL7APT",255,0) ...S ERRSND=1,ERRTXT=$E("Invalid Link assoc with institution: "_$G(INSTIEN),1,48) "RTN","SDHL7APT",256,0) ..Q "RTN","SDHL7APT",257,0) .K HLA,HLEVN "RTN","SDHL7APT",258,0) .N MC,HLFS,HLCS,IXX "RTN","SDHL7APT",259,0) .F IXX=1:1:CNT S HLA("HLS",IXX)=$G(@MSGROOT@(IXX)) "RTN","SDHL7APT",260,0) .M HLA("HLA")=HLA("HLS") "RTN","SDHL7APT",261,0) .S EIN=$$FIND1^DIC(101,,,"SD IFS EVENT DRIVER") "RTN","SDHL7APT",262,0) .;the following HL* variables are created by DIRECT^HLMA "RTN","SDHL7APT",263,0) .N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN,HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQ,HLQUITQ,SDLINK,OROK,MSASEG,ERRRSP "RTN","SDHL7APT",264,0) .; "RTN","SDHL7APT",265,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",266,0) ..K HL "RTN","SDHL7APT",267,0) ..D:$G(INTRA)=0 INIT^HLFNC2("SD IFS EVENT DRIVER",.HL) "RTN","SDHL7APT",268,0) ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND INTRAFACILITY",.HL) ;if intra "RTN","SDHL7APT",269,0) ..Q "RTN","SDHL7APT",270,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",271,0) ..K HL "RTN","SDHL7APT",272,0) ..D:$G(INTRA)=0 INIT^HLFNC2("SD TMP S15 SERVER EVENT DRIVER",.HL) "RTN","SDHL7APT",273,0) ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND CANCEL INTRA",.HL) ;if intra "RTN","SDHL7APT",274,0) ..Q "RTN","SDHL7APT",275,0) .S SITE=INSTIEN,STA=$$STA^XUAF4(SITE) "RTN","SDHL7APT",276,0) .S:$G(STA)="" STA=+$G(AIL(2,3,1,4)) "RTN","SDHL7APT",277,0) .D LINK^HLUTIL3(STA,.SDLINK,"I") "RTN","SDHL7APT",278,0) .S SDLINK=$O(SDLINK(0)) "RTN","SDHL7APT",279,0) .I SDLINK="" D Q "RTN","SDHL7APT",280,0) ..Q:$G(INTRA)=1 "RTN","SDHL7APT",281,0) ..S ERRSND=1,ERRTXT=$E("Message link undefined for facility: "_$G(INSTIEN),1,48) "RTN","SDHL7APT",282,0) ..Q "RTN","SDHL7APT",283,0) .S SDLINK=SDLINK(SDLINK) "RTN","SDHL7APT",284,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",285,0) ..S:$G(INTRA)=0 HLL("LINKS",1)="SD IFS SUBSCRIBER"_U_$G(SDLINK) "RTN","SDHL7APT",286,0) ..S:$G(INTRA)=1 HLL("LINKS",1)="SD TMP RECEIVE INTRAFACILITY"_U_$G(SDLINK) "RTN","SDHL7APT",287,0) ..Q "RTN","SDHL7APT",288,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",289,0) ..S:$G(INTRA)=0 HLL("LINKS",1)="SD TMP S15 CLIENT SUBSCRIBER"_U_$G(SDLINK) "RTN","SDHL7APT",290,0) ..S:$G(INTRA)=1 HLL("LINKS",1)="SD TMP RECEIVE CANCEL INTRA"_U_$G(SDLINK) "RTN","SDHL7APT",291,0) ..Q "RTN","SDHL7APT",292,0) .S HLMTIEN="" "RTN","SDHL7APT",293,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",294,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",295,0) ..I $G(INTRA)=1 D 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",296,0) ..Q "RTN","SDHL7APT",297,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",298,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",299,0) ..I $G(INTRA)=1 D 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",300,0) ..Q "RTN","SDHL7APT",301,0) .I 'HLMTIEN D Q "RTN","SDHL7APT",302,0) ..S ERRSND=1,ERRTXT=$E("Message sent to remote facility unsuccessful: "_$G(INSTIEN),1,48) "RTN","SDHL7APT",303,0) ..Q "RTN","SDHL7APT",304,0) .K @MSGROOT "RTN","SDHL7APT",305,0) .;Process response "RTN","SDHL7APT",306,0) .;NOTE: OCT 25 - need to test this to see if it will quit properly "RTN","SDHL7APT",307,0) .I $G(INTRA)=0 D "RTN","SDHL7APT",308,0) ..N HLNODE,SEG,I,RESP,IK "RTN","SDHL7APT",309,0) ..;H 2 "RTN","SDHL7APT",310,0) ..F IK=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7APT",311,0) ...S RESP(IK)=HLNODE "RTN","SDHL7APT",312,0) ...Q "RTN","SDHL7APT",313,0) ..S MSASEG=$G(RESP(2)) "RTN","SDHL7APT",314,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",315,0) .Q "RTN","SDHL7APT",316,0) ; "RTN","SDHL7APT",317,0) I +ERRSND D Q "RTN","SDHL7APT",318,0) .;S ERR="MSA^1^^100^AE^"_ERRTXT "RTN","SDHL7APT",319,0) .S ERR=$G(MSAHDR)_ERRTXT "RTN","SDHL7APT",320,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",321,0) .K @MSGROOT "RTN","SDHL7APT",322,0) .Q "RTN","SDHL7APT",323,0) K @MSGROOT "RTN","SDHL7APT",324,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APT",325,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APT",326,0) ;N SDSVCP,SDSVCPR,SDEKG,SDXRAY,SDCL,SDECRES,SDAPTYP,APPTYPE,EESTAT,SDPARENT,SDEL,OVB,SDECY,SDECLEN,SDREQBY,SDSVCP,APPTYPE,SDDDT,SDCL "RTN","SDHL7APT",327,0) S (SDSVCP,SDSVCPR,SDEKG,SDXRAY,SDLAB,SDECCR,SDECY,SDID,APPTYPE,EESTAT,SDEL)="",SDCL=$G(AIL(1,3,1,1)) "RTN","SDHL7APT",328,0) ;S SDECRES=$$RESLKUP^SDHL7APU(SDCL) "RTN","SDHL7APT",329,0) ;S:$G(RET1) SDECRES=RET1 "RTN","SDHL7APT",330,0) S SDECRES=$$RESLKUP^SDHL7APU($G(SDCL)) "RTN","SDHL7APT",331,0) S SDECRES=SDECRES,OVB=1 "RTN","SDHL7APT",332,0) S (SDMRTC,MSGARY("SDMRTC"))=$S($G(SDMRTC)=1:"TRUE",1:"FALSE"),SDLAB="",PROVIEN=MSGARY("PROVIEN") "RTN","SDHL7APT",333,0) I $P(SDAPTYP,"|",1)="R" D "RTN","SDHL7APT",334,0) .S $P(SDAPTYP,"|",1)="A" "RTN","SDHL7APT",335,0) .I $P(SDAPTYP,"|",2)=$G(SDPARENT) S:$P($G(^SDEC(409.85,$G(SDPARENT),3)),"^")="" SDPARENT="" "RTN","SDHL7APT",336,0) K INP D INP^SDHL7APU "RTN","SDHL7APT",337,0) S (ERRCND,ERRTXT)="" "RTN","SDHL7APT",338,0) N SUCCESS "RTN","SDHL7APT",339,0) S SUCCESS=0 "RTN","SDHL7APT",340,0) S (PROVIEN,DUZ)=$G(MSGARY("DUZ")) "RTN","SDHL7APT",341,0) S:$G(DUZ)="" (PROVIEN,DUZ)=.5 "RTN","SDHL7APT",342,0) S:$G(DUZ(2))="" DUZ(2)=$G(MSGARY("HLTHISSITE")) "RTN","SDHL7APT",343,0) S (INP(11),SDDDT)=$G(SCH(11,1,8)) "RTN","SDHL7APT",344,0) I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",345,0) .S URL=$G(AILNTE) "RTN","SDHL7APT",346,0) .I $P($G(SDAPTYP),"|")="A"&($G(SDAPT)>0) D "RTN","SDHL7APT",347,0) ..S $P(SDAPTYP,"|",2)=SDAPT "RTN","SDHL7APT",348,0) ..S:$G(SDDDT)="" (INP(11),SDDDT)=$P(SDECSTART,"@",1),SDECATID="WALKIN" "RTN","SDHL7APT",349,0) .S:$P($G(SDAPTYP),"|",1)="R" $P(SDAPTYP,"|",1)="A" "RTN","SDHL7APT",350,0) .S:$G(SDPARENT)=$P(SDAPTYP,"|",2) SDPARENT="" "RTN","SDHL7APT",351,0) .;I ($P($G(SDAPTYP),"|")="A"&($P($G(SDAPTYP),"|",2)="")) S $P(SDAPTYP,"|",2)=$G(SDCHILD) "RTN","SDHL7APT",352,0) .;S:$P($G(SDAPTYP),"|")="" SDAPTYP="A|"_$G(SDCHILD) "RTN","SDHL7APT",353,0) .;I $G(AIL(1,4,1,2))="A" S $P(SDAPTYP,"|")="A", SDDDT=$P(SDECSTART,"@",1),SDECATID="WALKIN" "RTN","SDHL7APT",354,0) .I $$PATCH^XPDUTL("SD*5.3*694") S SDECEND=$$FMTE^XLFDT(SDECEND) "RTN","SDHL7APT",355,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,$G(SDPARENT),SDEL) ;ADD NEW APPOINTMENT "RTN","SDHL7APT",356,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",357,0) .S URL=$G(AILNTE) "RTN","SDHL7APT",358,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",359,0) .N TMP2 S TMP2=$G(^TMP("SDEC07",$J,2)) "RTN","SDHL7APT",360,0) .I ((+$P(TMP2,"^",1)>0)&($L($P(TMP2,"^",3))<1)) S SUCCESS=1 "RTN","SDHL7APT",361,0) .I SUCCESS=0 S ERRTXT=$P($G(^TMP("SDEC07",$J,2)),"^",3) "RTN","SDHL7APT",362,0) .I ((SUCCESS=0)&(ERRTXT="")) D "RTN","SDHL7APT",363,0) ..S ERRTXT=$P($G(^TMP("SDEC07",$J,3)),"^",2) "RTN","SDHL7APT",364,0) ..Q "RTN","SDHL7APT",365,0) .I $L(ERRTXT) S ERRCND=9999 "RTN","SDHL7APT",366,0) .S DUZ(2)=$G(STA) "RTN","SDHL7APT",367,0) .I $G(SUCCESS)>0 D "RTN","SDHL7APT",368,0) ..;N SWITCH S SWITCH=1 S:$P($G(SDAPTYP),"|",2)=SDPARENT SWITCH=2 "RTN","SDHL7APT",369,0) ..;N INPA S INPA(1)=$P(SDAPTYP,"|",2),INPA(2)=$S($G(SWITCH)=1:"SA",$G(SWITCH)=2:"MC",1:"SA"),INPA(3)=$G(DUZ),DUZ(2)=$G(STA) ;INP(1) is the IEN of the PARENT order "RTN","SDHL7APT",370,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",371,0) ..S INPA(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",372,0) ..N RET D ARCLOSE^SDECAR(.RET,.INPA) ; Dispositions the order. "RTN","SDHL7APT",373,0) ..;S $P(^SDEC(409.85,$P($G(SDAPTYP),"|",2),0),"^",5)="APPT" "RTN","SDHL7APT",374,0) ..;N RTN S INP(24)=$G(SDAPT)_"~"_$G(SDCHILD) D ARSET^SDECAR2(.RTN,.INP) ;Update files for RTC orders. "RTN","SDHL7APT",375,0) ..I $G(SDPARENT)'="" N CLOSEOUT S CLOSEOUT=0 I $G(RTCID)>0 S:$G(RTCID)=$P($G(^SDEC(409.85,+$G(SDPARENT),3)),"^",3) CLOSEOUT=1 "RTN","SDHL7APT",376,0) ..I $G(CLOSEOUT)=1 D ;if this is the last child close out the parent and all child orders "RTN","SDHL7APT",377,0) ...N INP S INP(1)=+SDPARENT,INP(2)="SA",INP(3)=$G(DUZ),DUZ(2)=$G(STA) "RTN","SDHL7APT",378,0) ...S INP(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",379,0) ...D ARCLOSE^SDECAR(.RET,.INP) "RTN","SDHL7APT",380,0) ...;Parent Appointment Request Closed now loop thru the 3 node and update each of the children to disposition of "MC" "RTN","SDHL7APT",381,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",382,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",383,0) ....S INP(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",384,0) ....D ARCLOSE^SDECAR(.RET,.INP) "RTN","SDHL7APT",385,0) ....Q "RTN","SDHL7APT",386,0) ...;S $P(^SDEC(409.85,+SDPARENT,0),"^",5)="APPT" "RTN","SDHL7APT",387,0) ...Q "RTN","SDHL7APT",388,0) ..Q "RTN","SDHL7APT",389,0) .Q "RTN","SDHL7APT",390,0) ;SECAPPT ; If this is an intrafacility appointment make the second appointment "RTN","SDHL7APT",391,0) I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",392,0) .N XDT,%D,X,Y,STARTDT,ERRTXT,ERRCND "RTN","SDHL7APT",393,0) .S SDECCR="",SDUSER=$G(MSGARY("DUZ")) "RTN","SDHL7APT",394,0) .S:$G(SDUSER)="" SDUSER=.5 "RTN","SDHL7APT",395,0) .S %DT="RXT",X=SDECSTART D ^%DT S STARTDT=Y "RTN","SDHL7APT",396,0) .S SDECAPTID=$$GETAPP^SDHLAPT1(DFN,SDECRES,STARTDT) "RTN","SDHL7APT",397,0) .;S SDECCR=$G(MSGARY("CANCODE")) "RTN","SDHL7APT",398,0) .S DUZ=$G(MSGARY("DUZ")) "RTN","SDHL7APT",399,0) .S:$G(DUZ)="" DUZ=.5 "RTN","SDHL7APT",400,0) .S:$G(DUZ(2))="" DUZ(2)=$G(MSGARY("HLTHISSITE")) "RTN","SDHL7APT",401,0) .D APPDEL^SDEC08(.SDECY,SDECAPTID,SDECTYP,$G(SDECCR),$G(SDECNOT),$G(SDECDATE),$G(SDUSER)) "RTN","SDHL7APT",402,0) .S ERRTXT=$P($G(^TMP("SDEC",$J,2)),"^") "RTN","SDHL7APT",403,0) .I +$L(ERRTXT)>0 S ERRCND=9999 "RTN","SDHL7APT",404,0) .D CHKCAN^SDHLAPT2(DFN,SDCL,STARTDT) "RTN","SDHL7APT",405,0) .;N SDECDA S SDECDA=$G(AIL(1,4)) "RTN","SDHL7APT",406,0) .;S:$G(SDECDA)'="" $P(^SDEC(409.85,SDECDA,0),"^",5)="RTC" "RTN","SDHL7APT",407,0) ; "RTN","SDHL7APT",408,0) I +ERRCND D "RTN","SDHL7APT",409,0) .S ERRTXT=$$ERRLKP^SDHL7APU(ERRTXT) "RTN","SDHL7APT",410,0) .Q "RTN","SDHL7APT",411,0) S ERRTXT=$$STRIP^SDHL7APU(ERRTXT) "RTN","SDHL7APT",412,0) ;S HIT=0,EXTIME="" "RTN","SDHL7APT",413,0) ; "RTN","SDHL7APT",414,0) ;****BUILD THE RESPONSE MSA "RTN","SDHL7APT",415,0) K @MSGROOT "RTN","SDHL7APT",416,0) N HLA "RTN","SDHL7APT",417,0) ; "RTN","SDHL7APT",418,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APT",419,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APT",420,0) ; "RTN","SDHL7APT",421,0) N ERR,LEN S ERR="" "RTN","SDHL7APT",422,0) N FOUNDCN "RTN","SDHL7APT",423,0) S FOUNDCN=0 "RTN","SDHL7APT",424,0) ; "RTN","SDHL7APT",425,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",426,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7APT",427,0) Q "RTN","SDHL7APU") 0^13^B259940586^B268918179 "RTN","SDHL7APU",1,0) SDHL7APU ;MS/TG,PH - TMP HL7 Routine;OCT 16, 2018 "RTN","SDHL7APU",2,0) ;;5.3;Scheduling;**704,714,773**;AUG 17, 2018;Build 9 "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) S ^XTMP("SDTMP",+MSH(9))="",$P(^XTMP("SDTMP",0),U,1)=$$FMADD^XLFDT(DT,7) ;773 "RTN","SDHL7APU",13,0) Q "RTN","SDHL7APU",14,0) SCH(SCH,INP,MSGARY) ; "RTN","SDHL7APU",15,0) N TM,TMM,CONSDSC,CANCODE "RTN","SDHL7APU",16,0) S SDAPTYP="A|" "RTN","SDHL7APU",17,0) S SDECATID=$G(SCH(6)) "RTN","SDHL7APU",18,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",19,0) S (SDECCR,CANCODE)=$G(SCH(6,1,2)) "RTN","SDHL7APU",20,0) I $G(MSGARY("EVENT"))="CANCELED" D "RTN","SDHL7APU",21,0) . Q:$G(SDECCR)="" "RTN","SDHL7APU",22,0) . S SDECCR=$O(^SD(409.2,"B",$G(CANCODE),0)) "RTN","SDHL7APU",23,0) . S:(SDECCR)="" SDECCR=11 "RTN","SDHL7APU",24,0) . S SDECTYP=$G(SCH(6,1,4)) "RTN","SDHL7APU",25,0) ;S SDECNOT=$G(SCH(6,1,5)) "RTN","SDHL7APU",26,0) S 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))'="" SDDDT=$G(SCH(11,1,8)) "RTN","SDHL7APU",30,0) I $G(SDDDT)="" S:$G(SCH(5,1,2))'="" SDDDT=$G(SCH(5,1,2)) "RTN","SDHL7APU",31,0) S:$G(TM)'="" SDECSTART=$P(TM,":",1,2)_":00.000Z" "RTN","SDHL7APU",32,0) ;S INP(11)=$G(SDDDT) "RTN","SDHL7APU",33,0) S 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 SDTYP S SDTYP=$G(SCH(6,1,4)) "RTN","SDHL7APU",38,0) I $G(SDTYP)="R" D "RTN","SDHL7APU",39,0) .S (RTCID,SDCHILD)=$G(SCH(7,1,1)),SDPARENT=$G(SCH(24,1,1)) "RTN","SDHL7APU",40,0) .S:$G(SDCHILD)="" (RTCID,SDCHILD)=$G(SCH(7,1,4)) "RTN","SDHL7APU",41,0) .S SDAPTYP="R|"_$G(SDCHILD) "RTN","SDHL7APU",42,0) .S:$P($G(^SDEC(409.85,$G(SDCHILD),3)),"^",1)>0 SDMTC=1 "RTN","SDHL7APU",43,0) .I $G(SDPARENT)>0 S:$P($G(^SDEC(409.85,$G(SDPARENT),3)),"^",1)>0 SDMTC=1 "RTN","SDHL7APU",44,0) S:$G(SDTYP)="" SDTYP="A",SDAPTYP="A|" "RTN","SDHL7APU",45,0) S:$G(SDTYP)="A" SDTYP="A",SDAPTYP="A|" "RTN","SDHL7APU",46,0) ; "RTN","SDHL7APU",47,0) Q "RTN","SDHL7APU",48,0) SCHNTE(SCHNTE,INP,MSGARY) ; "RTN","SDHL7APU",49,0) ; "RTN","SDHL7APU",50,0) S SDECNOTE=$G(SCHNTE(3)) "RTN","SDHL7APU",51,0) I $G(MSGARY("EVENT"))="CANCELED" S SDECNOT=$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)=$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(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=$$FMTE^XLFDT(XSDDDT) "RTN","SDHL7APU",102,0) .S SDAPTYP="C|"_$G(GMRDA) "RTN","SDHL7APU",103,0) .S:$G(GMRDA)=""!($G(GMRDA)'>0) SDAPTYP="A|" ;PB - Oct 24, Patch 714, put in to set SDAPTYP as a walkin - stops any looping issues "RTN","SDHL7APU",104,0) S:$G(AIL(1,3,1,4))=$G(AIL(2,3,1,4)) INTRA=1 "RTN","SDHL7APU",105,0) I $G(AIL(1,4,1,2))="A" S SDAPTYP="A|" "RTN","SDHL7APU",106,0) I $G(AIL(1,4,1,2))="R" S SDAPTYP="R|"_$G(AIL(1,4,1,4)) "RTN","SDHL7APU",107,0) Q "RTN","SDHL7APU",108,0) AILNTE(AILNTE,CNT,INP) ; "RTN","SDHL7APU",109,0) S:$D(AILNTE) AILNTE(CNT,1)=1 "RTN","SDHL7APU",110,0) S AILNTE=$G(AILNTE(1,3,2)) "RTN","SDHL7APU",111,0) I AILNTE="" S AILNTE=$G(AILNTE(1,3)) "RTN","SDHL7APU",112,0) Q "RTN","SDHL7APU",113,0) ; "RTN","SDHL7APU",114,0) AIP(AIP,CNT,INP,MSGARY) ; "RTN","SDHL7APU",115,0) S:$D(AIP) AIP(CNT,1)=1 "RTN","SDHL7APU",116,0) S MSGARY("PROVIEN")=$G(AIP(1,3)) "RTN","SDHL7APU",117,0) Q "RTN","SDHL7APU",118,0) ; "RTN","SDHL7APU",119,0) AIPNTE(AIPNTE,CNT,INP,MSGARY) ; "RTN","SDHL7APU",120,0) S:$D(AIPNTE) AIPNTE(CNT,1)=1 "RTN","SDHL7APU",121,0) Q "RTN","SDHL7APU",122,0) ; "RTN","SDHL7APU",123,0) CHKCHILD ; "RTN","SDHL7APU",124,0) N MTC,FIRST "RTN","SDHL7APU",125,0) K RTCCLIN "RTN","SDHL7APU",126,0) I $P($G(SDAPTYP),"|",1)="R" D ; if rtc check to see if the child is actually a parent "RTN","SDHL7APU",127,0) .I $G(SDPARENT)="" S:$G(SCH(24,1,1))'="" SDPARENT=$G(SCH(24,1,1)) "RTN","SDHL7APU",128,0) .I $G(SDPARENT)="" S:$G(SCH(23,1,1))'="" SDPARENT=$G(SCH(23,1,1)) "RTN","SDHL7APU",129,0) .;I $G(SDCHILD)=$G(SDPARENT) "RTN","SDHL7APU",130,0) .S:$G(SDPARENT)>0 MTC=$P($G(^SDEC(409.85,+$G(SDPARENT),3)),"^",3),SDMRTC=$S(MTC>0:"1",1:0) "RTN","SDHL7APU",131,0) .Q:$G(MTC)=0 ; Not a multi RTC "RTN","SDHL7APU",132,0) .S:$G(SDCL)>0 RTCCLIN=$P(^SDEC(409.85,$G(SDPARENT),0),"^",9) "RTN","SDHL7APU",133,0) .S DUZ=$G(MSGARY("DUZ")) "RTN","SDHL7APU",134,0) .Q:$G(RTCCLIN)'=SDCL "RTN","SDHL7APU",135,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",136,0) .Q:$G(X13)=MTC!($G(X13)>MTC) "RTN","SDHL7APU",137,0) .I $G(MTC)>0 F I=1:1:MTC Q:I>MTC D "RTN","SDHL7APU",138,0) ..S:INP(3)="" INP(3)=DT S INP(25)=SDPARENT,INP(6)=$P(^SDEC(409.85,SDPARENT,0),"^",9),RTN=0 "RTN","SDHL7APU",139,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",140,0) ..D ARSET^SDHLAPT1(.RTN,.INP) "RTN","SDHL7APU",141,0) ..I I=1 S:$P($G(RTN),"^",2)>0 FCHILD=$P(RTN,"^",2) "RTN","SDHL7APU",142,0) .Q "RTN","SDHL7APU",143,0) Q "RTN","SDHL7APU",144,0) VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message "RTN","SDHL7APU",145,0) ; "RTN","SDHL7APU",146,0) ; Messages handled: SIU^S12 "RTN","SDHL7APU",147,0) ; "RTN","SDHL7APU",148,0) ; SIU query messages must contain QPD and RCP segments "RTN","SDHL7APU",149,0) ; Any additional segments are ignored "RTN","SDHL7APU",150,0) ; "RTN","SDHL7APU",151,0) ; Input: "RTN","SDHL7APU",152,0) ; MSGROOT - Root of array holding message "RTN","SDHL7APU",153,0) ; XMT - Transmission parameters "RTN","SDHL7APU",154,0) ; "RTN","SDHL7APU",155,0) ; Output: "RTN","SDHL7APU",156,0) ; "RTN","SDHL7APU",157,0) ; XMT - Transmission parameters "RTN","SDHL7APU",158,0) ; ERR - segment^sequence^field^code^ACK type^error text "RTN","SDHL7APU",159,0) ; "RTN","SDHL7APU",160,0) N MSH,QPD,REQID,REQTYPE,QTAG,QNAME,RDF "RTN","SDHL7APU",161,0) N SEGTYPE,CNT "RTN","SDHL7APU",162,0) K QRY,ERR "RTN","SDHL7APU",163,0) S ERR="" "RTN","SDHL7APU",164,0) ; "RTN","SDHL7APU",165,0) Q 1 "RTN","SDHL7APU",166,0) ; "RTN","SDHL7APU",167,0) PARSESEG(SEG,DATA,HL) ;Generic segment parser "RTN","SDHL7APU",168,0) ;This procedure parses a single HL7 segment and builds an array "RTN","SDHL7APU",169,0) ;subscripted by the field number containing the data for that field. "RTN","SDHL7APU",170,0) ; Does not handle segments that span nodes "RTN","SDHL7APU",171,0) ; "RTN","SDHL7APU",172,0) ; Input: "RTN","SDHL7APU",173,0) ; SEG - HL7 segment to parse "RTN","SDHL7APU",174,0) ; HL - HL7 environment array "RTN","SDHL7APU",175,0) ; "RTN","SDHL7APU",176,0) ; Output: "RTN","SDHL7APU",177,0) ; Function value - field data array [SUB1:field, SUB2:repetition, "RTN","SDHL7APU",178,0) ; SUB3:component, SUB4:sub-component] "RTN","SDHL7APU",179,0) ; "RTN","SDHL7APU",180,0) N CMP ;component subscript "RTN","SDHL7APU",181,0) N CMPVAL ;component value "RTN","SDHL7APU",182,0) N FLD ;field subscript "RTN","SDHL7APU",183,0) N FLDVAL ;field value "RTN","SDHL7APU",184,0) N REP ;repetition subscript "RTN","SDHL7APU",185,0) N REPVAL ;repetition value "RTN","SDHL7APU",186,0) N SUB ;sub-component subscript "RTN","SDHL7APU",187,0) N SUBVAL ;sub-component value "RTN","SDHL7APU",188,0) N FS ;field separator "RTN","SDHL7APU",189,0) N CS ;component separator "RTN","SDHL7APU",190,0) N RS ;repetition separator "RTN","SDHL7APU",191,0) N SS ;sub-component separator "RTN","SDHL7APU",192,0) ; "RTN","SDHL7APU",193,0) K DATA "RTN","SDHL7APU",194,0) S FS=HL("FS") "RTN","SDHL7APU",195,0) S CS=$E(HL("ECH")) "RTN","SDHL7APU",196,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7APU",197,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7APU",198,0) ; "RTN","SDHL7APU",199,0) S DATA(0)=$P(SEG,FS) "RTN","SDHL7APU",200,0) S SEG=$P(SEG,FS,2,9999) "RTN","SDHL7APU",201,0) ; "RTN","SDHL7APU",202,0) F FLD=1:1:$L(SEG,FS) D "RTN","SDHL7APU",203,0) . S FLDVAL=$P(SEG,FS,FLD) "RTN","SDHL7APU",204,0) . F REP=1:1:$L(FLDVAL,RS) D "RTN","SDHL7APU",205,0) . . S REPVAL=$P(FLDVAL,RS,REP) "RTN","SDHL7APU",206,0) . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D "RTN","SDHL7APU",207,0) . . . S CMPVAL=$P(REPVAL,CS,CMP) "RTN","SDHL7APU",208,0) . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D "RTN","SDHL7APU",209,0) . . . . S SUBVAL=$P(CMPVAL,SS,SUB) "RTN","SDHL7APU",210,0) . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL "RTN","SDHL7APU",211,0) . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL "RTN","SDHL7APU",212,0) . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL "RTN","SDHL7APU",213,0) . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL "RTN","SDHL7APU",214,0) Q "RTN","SDHL7APU",215,0) ; "RTN","SDHL7APU",216,0) PARSEMSG(MSGROOT,HL) ; Message Parser "RTN","SDHL7APU",217,0) ; Does not handle segments that span nodes "RTN","SDHL7APU",218,0) ; Does not handle extremely long segments (uses a local) "RTN","SDHL7APU",219,0) ; Does not handle long fields (segment parser doesn't) "RTN","SDHL7APU",220,0) ; "RTN","SDHL7APU",221,0) N SEG,CNT,DATA,MSG "RTN","SDHL7APU",222,0) F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D "RTN","SDHL7APU",223,0) . D PARSESEG(SEG(0),.DATA,.HL) "RTN","SDHL7APU",224,0) . K @MSGROOT@(CNT) "RTN","SDHL7APU",225,0) . I DATA(0)'="" M @MSGROOT@(CNT)=DATA "RTN","SDHL7APU",226,0) . Q:'$D(SEG(1)) "RTN","SDHL7APU",227,0) . Q "RTN","SDHL7APU",228,0) Q "RTN","SDHL7APU",229,0) ; "RTN","SDHL7APU",230,0) SEND() ; "RTN","SDHL7APU",231,0) Q "RTN","SDHL7APU",232,0) ACKIN ; "RTN","SDHL7APU",233,0) Q "RTN","SDHL7APU",234,0) INP ; set up the INP array for calling ARSET^SDECAR2 to update the RTC orders "RTN","SDHL7APU",235,0) ; Need to add code to add the rtcparent to the HL7 message and to parse it out. "RTN","SDHL7APU",236,0) N NODE3,INTV,NUMAPT,ORDATE,SDCHILD,SDPARENT "RTN","SDHL7APU",237,0) K INP "RTN","SDHL7APU",238,0) S:$G(MSGARY("PROVIEN"))>0 INP(10)=$$GET1^DIQ(200,$G(MSGARY("PROVIEN"))_",",.01,"E") "RTN","SDHL7APU",239,0) ; "RTN","SDHL7APU",240,0) S SDPARENT=$G(SCH(24,1,1)) "RTN","SDHL7APU",241,0) S PCE="" S PCE=$P($G(^DPT($G(DFN),"ENR")),U,1) I PCE'="" D "RTN","SDHL7APU",242,0) .S INP(13)=$$GET1^DIQ(27.11,PCE,.07,"E") "RTN","SDHL7APU",243,0) S:$G(SDMRTC)'="" INP(14)=$S(SDMRTC=1:"YES",SDMRTC=0:"NO",1:"") "RTN","SDHL7APU",244,0) ;I $G(SDPARENT)'="" S SDPARENT=$G(MSGARY("SDPARENT")) "RTN","SDHL7APU",245,0) I +$G(SDPARENT)>0 S NODE3=$G(^SDEC(409.85,+SDPARENT,3)),INTV=$P(NODE3,"^",2) "RTN","SDHL7APU",246,0) S INP(1)=$P(SDAPTYP,"|") ;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",247,0) S INP(2)=$G(DFN) "RTN","SDHL7APU",248,0) D NOW^%DTC S NOW=$$HTFM^XLFDT($H),INP(3)=$$FMTE^XLFDT(NOW) "RTN","SDHL7APU",249,0) ;NEEDS THE TEXT INSTITUTION NAME "RTN","SDHL7APU",250,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",251,0) S INP(5)="APPT" "RTN","SDHL7APU",252,0) S INP(6)=$G(SDCL) "RTN","SDHL7APU",253,0) S INP(7)="" ;null for TMP appointments or can we get this from the original RTC order? "RTN","SDHL7APU",254,0) S INP(8)="FUTURE" "RTN","SDHL7APU",255,0) N X11 S X11=$P($G(SDAPTYP),"|") S:$G(X11)="" X11="A" "RTN","SDHL7APU",256,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",257,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",258,0) S SDDDT=$G(SCH(5,1,2)) "RTN","SDHL7APU",259,0) S:$G(SDDDT)="" SDDDT=$G(SCH(11,1,8)) "RTN","SDHL7APU",260,0) S:$G(SDDDT)="" SDDDT=$P($G(SDECSTART),"T",1) ; Clinically Indicate Date for first appointment in the sequence, each of the remaining appointments have to be calculated "RTN","SDHL7APU",261,0) S INP(11)=$G(SDDDT) "RTN","SDHL7APU",262,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",263,0) S PCE="" S PCE=$P($G(^DPT(DFN,"ENR")),U,1) I PCE'="" D "RTN","SDHL7APU",264,0) .S INP(13)=$$GET1^DIQ(27.11,PCE,.07,"E") "RTN","SDHL7APU",265,0) S INP(14)="" "RTN","SDHL7APU",266,0) S:$G(SDMRTC)'="" INP(14)=$S(SDMRTC=1:"YES",SDMRTC=0:"NO",1:"NO") ; SDMRTC=1:YES "RTN","SDHL7APU",267,0) S INP(15)=$G(INTV) ;If MRTC, the interval in days between appointments "RTN","SDHL7APU",268,0) S INP(16)=$G(AIL(1,4,1,4)) ;If MRTC, the appointment number for this appointment "RTN","SDHL7APU",269,0) S INP(17)="" ;null for TMP "RTN","SDHL7APU",270,0) N SCXX S SCXX=$S($G(SDPARENT)>0:$$GET1^DIQ(409.85,SDPARENT_",",15,"I"),1:0) "RTN","SDHL7APU",271,0) S INP(18)=$S($G(SCXX)=1:"YES",1:"NO") ;is this service connected? we can get this from the parent "RTN","SDHL7APU",272,0) S SCPERC=0 "RTN","SDHL7APU",273,0) S SCPERC=$P(^DPT($G(INP(2)),.3),"^",2) "RTN","SDHL7APU",274,0) S INP(19)=SCPERC "RTN","SDHL7APU",275,0) S INP(22)="9" "RTN","SDHL7APU",276,0) S INP(23)="NEW" "RTN","SDHL7APU",277,0) S:$G(SDCHILD)=$G(SDPARENT) SDPARENT="" "RTN","SDHL7APU",278,0) S INP(25)=$G(SDPARENT) "RTN","SDHL7APU",279,0) S:$G(SDPARENT)>0 INP(28)=$P($G(^SDEC(409.85,+SDPARENT,7)),U,1) ; this is the CPRS order number "RTN","SDHL7APU",280,0) S:$G(INP(28))>0 INP(26)=$P($G(^SDEC(409.85,+SDPARENT,7)),U,2) "RTN","SDHL7APU",281,0) Q "RTN","SDHL7APU",282,0) ARSET(X) ; set the appointment requests into 409.85 "RTN","SDHL7APU",283,0) Q "RTN","SDHL7APU",284,0) S STOP=0 "RTN","SDHL7APU",285,0) I $G(X)'>0 Q STOP "RTN","SDHL7APU",286,0) I $G(^SDEC(409.85,X,0))="" Q STOP "RTN","SDHL7APU",287,0) I $G(^SDEC(409.85,X,3),"^")=1 D ; it is a multiple appointment rtc order "RTN","SDHL7APU",288,0) .S INTV=$P(^SDEC(409.85,X,3),"^",2),NUMAPT=$P(^SDEC(409.85,X,3),"^",3) "RTN","SDHL7APU",289,0) Q "RTN","SDHL7APU",290,0) LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing "RTN","SDHL7APU",291,0) ; "RTN","SDHL7APU",292,0) ;This subroutine assumes that all VistA HL7 environment variables are "RTN","SDHL7APU",293,0) ;properly initialized and will produce a fatal error if they aren't. "RTN","SDHL7APU",294,0) ; "RTN","SDHL7APU",295,0) N CNT,SEG "RTN","SDHL7APU",296,0) K @MSGROOT "RTN","SDHL7APU",297,0) F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7APU",298,0) . S CNT=0 "RTN","SDHL7APU",299,0) . S @MSGROOT@(SEG,CNT)=HLNODE "RTN","SDHL7APU",300,0) . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) "RTN","SDHL7APU",301,0) . Q "RTN","SDHL7APU",302,0) Q "RTN","SDHL7APU",303,0) LOADXMT(HL,XMT) ;Set HL dependent XMT values "RTN","SDHL7APU",304,0) ; "RTN","SDHL7APU",305,0) ; The HL array and variables are expected to be defined. If not, "RTN","SDHL7APU",306,0) ; message processing will fail. These references should not be "RTN","SDHL7APU",307,0) ; wrapped in $G, as null values will simply postpone the failure to "RTN","SDHL7APU",308,0) ; a point that will be harder to diagnose. Except HL("APAT") which "RTN","SDHL7APU",309,0) ; is not defined on synchronous calls. "RTN","SDHL7APU",310,0) ; "RTN","SDHL7APU",311,0) ; Integration Agreements: "RTN","SDHL7APU",312,0) ; 1373 : Reference to PROTOCOL file #101 "RTN","SDHL7APU",313,0) ; "RTN","SDHL7APU",314,0) N SUBPROT,RESPIEN,RESP0 "RTN","SDHL7APU",315,0) ;S HL("EID")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7APU",316,0) ;S HL("EIDS")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Subscriber") "RTN","SDHL7APU",317,0) S HL("EID")=$$FIND1^DIC(101,,,"SD TMP S12 SERVER EVENT DRIVER") "RTN","SDHL7APU",318,0) S HL("EIDS")=$$FIND1^DIC(101,,,"SD TMP S12 CLIENT SUBSCRIBER") "RTN","SDHL7APU",319,0) ;S HLL("LINKS",1)="SD IFS SUBSCRIBER^TMP_SEND" "RTN","SDHL7APU",320,0) S XMT("MID")=HL("MID") ;Message ID "RTN","SDHL7APU",321,0) S XMT("MODE")="A" ;Response mode "RTN","SDHL7APU",322,0) I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode "RTN","SDHL7APU",323,0) S XMT("MESSAGE TYPE")=HL("MTN") ;Message type "RTN","SDHL7APU",324,0) S XMT("EVENT TYPE")=HL("ETN") ;Event type "RTN","SDHL7APU",325,0) S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters "RTN","SDHL7APU",326,0) ;S XMT("DELIM")="~^\&" "RTN","SDHL7APU",327,0) S XMT("MAX SIZE")=0 ;Default size unlimited "RTN","SDHL7APU",328,0) ; "RTN","SDHL7APU",329,0) ; Map response protocol and builder "RTN","SDHL7APU",330,0) S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") "RTN","SDHL7APU",331,0) Q "RTN","SDHL7APU",332,0) ERRLKP(ERRTXT) ; "RTN","SDHL7APU",333,0) N ERTXI,ERTX1,ERTX2,X,XSP,ERTXT "RTN","SDHL7APU",334,0) S ERTXT=ERRTXT "RTN","SDHL7APU",335,0) S XSP=0 "RTN","SDHL7APU",336,0) F ERTXI=1:1 S X=$P($TEXT(ERRS+ERTXI),";;",2) Q:X="" Q:XSP D "RTN","SDHL7APU",337,0) . S ERTX1=$P(X,"^",1) "RTN","SDHL7APU",338,0) . S ERTX2=$P(X,"^",2) "RTN","SDHL7APU",339,0) . I ERTX1'="",ERTX2'="" I ERTXT[ERTX1 S ERTXT=ERTX2,XSP=1 "RTN","SDHL7APU",340,0) . Q "RTN","SDHL7APU",341,0) Q ERTXT "RTN","SDHL7APU",342,0) CHKAPT(RET,DFN,CLINID) ; "RTN","SDHL7APU",343,0) N XX,STATUS "RTN","SDHL7APU",344,0) Q:$G(DFN)'>0 "RTN","SDHL7APU",345,0) Q:$G(CLINID)'>0 "RTN","SDHL7APU",346,0) Q:'$D(^DPT(DFN,0)) "RTN","SDHL7APU",347,0) Q:'$D(^SC(CLINID,0)) "RTN","SDHL7APU",348,0) S RET=0,STATUS=0 "RTN","SDHL7APU",349,0) S XX=0 F S XX=$O(^SDEC(409.85,"SCC",DFN,CLINID,XX)) Q:XX'>0 D "RTN","SDHL7APU",350,0) . Q:$G(STATUS)=1 "RTN","SDHL7APU",351,0) . S:$P($G(^SDEC(409.85,XX,"SDAPT")),"^")'="" STATUS=1 "RTN","SDHL7APU",352,0) . S:$P(^SDEC(409.85,XX,0),"^",17)="O" STATUS=1,RET=XX "RTN","SDHL7APU",353,0) Q RET "RTN","SDHL7APU",354,0) STRIP(SDECZ) ;Replace control characters with spaces "RTN","SDHL7APU",355,0) N SDECI "RTN","SDHL7APU",356,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",357,0) Q SDECZ "RTN","SDHL7APU",358,0) ; "RTN","SDHL7APU",359,0) RESLKUP(CLINID) ; "RTN","SDHL7APU",360,0) ;uses the CLINID to lookup the clinic in the SDEC RESOURCE FILE "RTN","SDHL7APU",361,0) N STOP,XX "RTN","SDHL7APU",362,0) K RET,RET1 "RTN","SDHL7APU",363,0) S RET=0 "RTN","SDHL7APU",364,0) I $G(CLINID)'>0 S RET="0^Invalid Clinic ID" Q "RTN","SDHL7APU",365,0) I '$D(^SC(CLINID,0)) S RET="0^Clinic is not in the Hospital Location file" Q "RTN","SDHL7APU",366,0) S (STOP,XX)=0 F S XX=$O(^SDEC(409.831,"ALOC",CLINID,XX)) Q:XX'>0 D "RTN","SDHL7APU",367,0) . Q:$G(STOP)=1 "RTN","SDHL7APU",368,0) . I $P($G(^SDEC(409.831,XX,0)),"^",11)["SC(" S STOP=1,RET=XX "RTN","SDHL7APU",369,0) S RET1=RET "RTN","SDHL7APU",370,0) Q RET1 "RTN","SDHL7APU",371,0) GETAPT(URL,SDCL,SDECSTART) ; "RTN","SDHL7APU",372,0) N STOP,SNODE,CNODE,XX "RTN","SDHL7APU",373,0) S STOP=0 "RTN","SDHL7APU",374,0) Q:$L(URL)'>0 ;if no url, nothing to do here "RTN","SDHL7APU",375,0) Q:$L(SDCL)'>0 ;SDCL is required "RTN","SDHL7APU",376,0) Q:'$D(^SC(SDCL,0)) ;Clinic doesn't exist "RTN","SDHL7APU",377,0) Q:'$D(^SC(SDCL,"S",SDECSTART)) ; Appointment doesnt' exist "RTN","SDHL7APU",378,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",379,0) .I $P(^SC(SDCL,"S",SDECSTART,1,XX,0),"^")=DFN D "RTN","SDHL7APU",380,0) . . S SNODE=$G(^SC(SDCL,"S",SDECSTART,1,XX,0)) "RTN","SDHL7APU",381,0) . . S CNODE=$P($G(^SC(SDCL,"S",SDECSTART,1,XX,"CONS")),"^") "RTN","SDHL7APU",382,0) . . S ^SC(SDCL,"S",SDECSTART,1,XX,"URL")=$G(URL) "RTN","SDHL7APU",383,0) . . S STOP=1 "RTN","SDHL7APU",384,0) Q STOP "RTN","SDHL7APU",385,0) CHKLL(X) ;check setup of Logical Link "RTN","SDHL7APU",386,0) ;input value: X = institution number or name "RTN","SDHL7APU",387,0) ;return value: 1 = setup OK "RTN","SDHL7APU",388,0) ; 0 = LL setup incorrect "RTN","SDHL7APU",389,0) N HLRESLT "RTN","SDHL7APU",390,0) D LINK^HLUTIL3(X,.HLRESLT) "RTN","SDHL7APU",391,0) S X=+$O(HLRESLT(0)) Q:'X 0 "RTN","SDHL7APU",392,0) ; "RTN","SDHL7APU",393,0) Q $$LLOK^HLCSLM(X) "RTN","SDHL7APU",394,0) SENDERR(ERR) ; Send for unsuccessful response "RTN","SDHL7APU",395,0) K @MSGROOT "RTN","SDHL7APU",396,0) N HLA "RTN","SDHL7APU",397,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APU",398,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APU",399,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7APU",400,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7APU",401,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7APU",402,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7APU",403,0) K @MSGROOT "RTN","SDHL7APU",404,0) Q "RTN","SDHL7APU",405,0) DUZ ; send error nak back if user not on system "RTN","SDHL7APU",406,0) S ERR="MSA^1^^100^AE^SCHEDULER NOT AUTHORIZED ON THIS VISTA" "RTN","SDHL7APU",407,0) D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APU",408,0) K @MSGROOT "RTN","SDHL7APU",409,0) Q "RTN","SDHL7APU",410,0) ERRS ; "RTN","SDHL7APU",411,0) ;;already has appt at^Patient already has an appt at that datetime "RTN","SDHL7APU",412,0) ;;already has appt at^Patient already has an appt "RTN","SDHL7APU",413,0) ;;SDEC07 Error: This RTC request has been closed^This RTC request has been closed "RTN","SDHL7APU",414,0) ;;SDEC07 Error: Invalid Start Time^Invalid Start Time "RTN","SDHL7APU",415,0) ;;SDEC07 Error: Invalid End Time^Invalid End Time "RTN","SDHL7APU",416,0) ;;SDEC07: Patient ID required.^Patient ID required "RTN","SDHL7APU",417,0) ;;SDEC07 Error: Invalid Patient ID^Invalid Patient ID "RTN","SDHL7APU",418,0) ;;Patient is being edited. Try again later.^Patient is being edited. "RTN","SDHL7APU",419,0) ;;SDEC07 Error: Invalid Resource ID^Invalid Resource ID "RTN","SDHL7APU",420,0) ;;SDEC07 Error: Unable to add appointment -- invalid Resource entry.^Unable to add appt - invalid Resource entry "RTN","SDHL7APU",421,0) ;;SDEC07 Error: Appointment length must be between 5 - 120.^Appointment length must be between 5 - 120 "RTN","SDHL7APU",422,0) ;;SDEC07 Error: Invalid appointment request type.^Invalid appointment request type "RTN","SDHL7APU",423,0) ;;THAT TIME IS NOT WITHIN SCHEDULED PERIOD^That time not within scheduled period "RTN","SDHL7APU",424,0) ;;SDEC07 Error: Invalid clinic ID.^Invalid clinic ID "RTN","SDHL7APU",425,0) ;;is an inactive clinic.^Clinic is inactive "RTN","SDHL7APU",426,0) ;;Another user is working with this patient's record. Please try again later^Patient record locked "RTN","SDHL7APU",427,0) ;;SDEC07 Error: Unable to add appointment to SDEC APPOINTMENT file.^Can't add appointment to SDEC APPOINTMENT file "RTN","SDHL7APU",428,0) ;;Invalid Clinic ID - Cannot determine if Overbook is allowed.^Cannot determine if Overbook is allowed. "RTN","SDHL7APU",429,0) ;;Invalid Appointment Date.^Invalid Appointment Date. "RTN","SDHL7APU",430,0) ;;SDEC08: Invalid Appointment ID^Invalid Appointment ID "RTN","SDHL7APU",431,0) ;;Error adding date to file 44: Clinic^Error adding date to file 44 "RTN","SDHL7APU",432,0) ;;SDEC08: Invalid status type^Invalid status type "RTN","SDHL7APU",433,0) ;;Another user is working with this patient's record. Please try again later^Patient record locked "RTN","SDHL7APU",434,0) ;;Invalid Appointment ID.^Invalid Appointment ID "RTN","SDHL7APU",435,0) ;;Appointment is not Cancelled.^Appointment is not Cancelled "RTN","SDHL7APU",436,0) ;;Cancelled by patient appointment cannot be uncancelled.^Cannot be uncancelled "RTN","SDHL7APU",437,0) ;;FileMan add toS DPT error: Patient=^FileMan add toS DPT error "RTN","SDHL7APU",438,0) ;;Another user is working with this patient's record. Please try again later^Patient record locked "RTN","SDHL7CON") 0^10^B103881672^B108890103 "RTN","SDHL7CON",1,0) SDHL7CON ;MS/TG/MS/PB - TMP HL7 Routine;JULY 05, 2018 "RTN","SDHL7CON",2,0) ;;5.3;Scheduling;**704,773**;May 29, 2018;Build 9 "RTN","SDHL7CON",3,0) ; "RTN","SDHL7CON",4,0) ; Integration Agreements: "RTN","SDHL7CON",5,0) ; "RTN","SDHL7CON",6,0) ;SD*5.3*773 - Removed unused function TMCONV "RTN","SDHL7CON",7,0) Q "RTN","SDHL7CON",8,0) ; "RTN","SDHL7CON",9,0) PARSEQ13 ;Process QBP^Q13 messages from the "TMP VISTA" Subscriber protocol "RTN","SDHL7CON",10,0) ; "RTN","SDHL7CON",11,0) ; This routine and subroutines assume that all VistA HL7 environment "RTN","SDHL7CON",12,0) ; variables are properly initialized and will produce a fatal error "RTN","SDHL7CON",13,0) ; if they are missing. "RTN","SDHL7CON",14,0) ; "RTN","SDHL7CON",15,0) ; The message will be checked to see if it is a valid query. "RTN","SDHL7CON",16,0) ; If not a negative acknowledgement will be sent. If the query is an "RTN","SDHL7CON",17,0) ; immediate mode or synchronous query, the realtime request manager "RTN","SDHL7CON",18,0) ; is called to handle the query. This means the query will be "RTN","SDHL7CON",19,0) ; processed and a response generated immediately. "RTN","SDHL7CON",20,0) ; In the future deferred mode queries may be filed in a database for "RTN","SDHL7CON",21,0) ; later processing, or transmission. "RTN","SDHL7CON",22,0) ; "RTN","SDHL7CON",23,0) ; Input: "RTN","SDHL7CON",24,0) ; HL7 environment variables "RTN","SDHL7CON",25,0) ; "RTN","SDHL7CON",26,0) ; Output: "RTN","SDHL7CON",27,0) ; Processed query or negative acknowledgement "RTN","SDHL7CON",28,0) ; If handled real-time the query response is generated "RTN","SDHL7CON",29,0) ; "RTN","SDHL7CON",30,0) ; Integration Agreements "RTN","SDHL7CON",31,0) ; "RTN","SDHL7CON",32,0) N MSGROOT,DATAROOT,QRY,XMT,ERR,RNAME,IX "RTN","SDHL7CON",33,0) S (MSGROOT,QRY,XMT,ERR,RNAME)="" "RTN","SDHL7CON",34,0) ; Inbound query messages are small enough to be held in a local. "RTN","SDHL7CON",35,0) ; The following lines commented out support use of global and are "RTN","SDHL7CON",36,0) ; left in case use a global becomes necessary. "RTN","SDHL7CON",37,0) ; "RTN","SDHL7CON",38,0) S MSGROOT="SDHL7MSG" "RTN","SDHL7CON",39,0) K @MSGROOT "RTN","SDHL7CON",40,0) N EIN "RTN","SDHL7CON",41,0) S EIN=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7CON",42,0) ; "RTN","SDHL7CON",43,0) D LOADXMT(.HL,.XMT) ;Load inbound message information "RTN","SDHL7CON",44,0) S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER" "RTN","SDHL7CON",45,0) ; "RTN","SDHL7CON",46,0) N CNT,SEG "RTN","SDHL7CON",47,0) K @MSGROOT "RTN","SDHL7CON",48,0) D LOADMSG(MSGROOT) "RTN","SDHL7CON",49,0) ; "RTN","SDHL7CON",50,0) D PARSEMSG(MSGROOT,.HL) "RTN","SDHL7CON",51,0) ; "RTN","SDHL7CON",52,0) I '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR) D Q "RTN","SDHL7CON",53,0) . D SENDERR(ERR) "RTN","SDHL7CON",54,0) . K @MSGROOT "RTN","SDHL7CON",55,0) . Q "RTN","SDHL7CON",56,0) ; "RTN","SDHL7CON",57,0) N CNT,RDT,HIT,EXTIME,RDF,QPD,QRYDFN,MSGCONID,LST,MYRESULT,HLA,RTCLST "RTN","SDHL7CON",58,0) ; "RTN","SDHL7CON",59,0) S (MSGCONID,QRYDFN)="" "RTN","SDHL7CON",60,0) S CNT=1 "RTN","SDHL7CON",61,0) ; "RTN","SDHL7CON",62,0) F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 "RTN","SDHL7CON",63,0) . S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7CON",64,0) . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT) S QRYDFN=$G(@MSGROOT@(CNT,3)) Q "RTN","SDHL7CON",65,0) . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q "RTN","SDHL7CON",66,0) . I SEGTYPE="MSH" S MSGCONID=$G(@MSGROOT@(CNT,9)) Q "RTN","SDHL7CON",67,0) . Q "RTN","SDHL7CON",68,0) ; "RTN","SDHL7CON",69,0) I QRYDFN="" D Q "RTN","SDHL7CON",70,0) . S ERR="QPD^1^^100^AE^No DFN value sent" "RTN","SDHL7CON",71,0) . D SENDERR(ERR) "RTN","SDHL7CON",72,0) . K @MSGROOT "RTN","SDHL7CON",73,0) . Q "RTN","SDHL7CON",74,0) ; "RTN","SDHL7CON",75,0) I '$D(^DPT(QRYDFN,0)) D Q "RTN","SDHL7CON",76,0) . S ERR="QPD^1^^100^AE^Undefined DFN" "RTN","SDHL7CON",77,0) . D SENDERR(ERR) "RTN","SDHL7CON",78,0) . K @MSGROOT "RTN","SDHL7CON",79,0) . Q "RTN","SDHL7CON",80,0) S DATAROOT=$NA(^TMP("ORQQCN",$J,"CS")) "RTN","SDHL7CON",81,0) K @DATAROOT "RTN","SDHL7CON",82,0) D LIST(.LST,QRYDFN) "RTN","SDHL7CON",83,0) D RTCLIST(.RTCLST,QRYDFN) "RTN","SDHL7CON",84,0) ; "RTN","SDHL7CON",85,0) I '$D(^TMP("ORQQCN",$J,"CS")) D Q "RTN","SDHL7CON",86,0) . S ERR="RDT^1^^100^AA^No consults found" "RTN","SDHL7CON",87,0) . D SENDERR(ERR) "RTN","SDHL7CON",88,0) . K @DATAROOT,@MSGROOT "RTN","SDHL7CON",89,0) . Q "RTN","SDHL7CON",90,0) ; "RTN","SDHL7CON",91,0) S HIT=0,EXTIME="" "RTN","SDHL7CON",92,0) ; "RTN","SDHL7CON",93,0) ;****BUILD THE RESPONSE MSG "RTN","SDHL7CON",94,0) K @MSGROOT "RTN","SDHL7CON",95,0) ; "RTN","SDHL7CON",96,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7CON",97,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7CON",98,0) ; "RTN","SDHL7CON",99,0) N ERR,LEN S ERR="" "RTN","SDHL7CON",100,0) N FOUNDCN "RTN","SDHL7CON",101,0) S FOUNDCN=0 "RTN","SDHL7CON",102,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",103,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^SDTMBUS(.HL,""),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",104,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.QPD,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",105,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.RDF,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",106,0) I '$P(ERR,"^",4) D "RTN","SDHL7CON",107,0) . Q:DATAROOT="" "RTN","SDHL7CON",108,0) . D @("RDT^SDTMBUS"_"(MSGROOT,DATAROOT,.CNT,.LEN,.HL,.FOUNDCN)") "RTN","SDHL7CON",109,0) . D RTCRDT^SDTMBUS(MSGROOT,RTCLST,.CNT,.LEN,.HL) "RTN","SDHL7CON",110,0) . Q "RTN","SDHL7CON",111,0) ; "RTN","SDHL7CON",112,0) I 'FOUNDCN D Q "RTN","SDHL7CON",113,0) . S ERR="RDT^1^^100^AA^No consults found" "RTN","SDHL7CON",114,0) . D SENDERR(ERR) "RTN","SDHL7CON",115,0) . K @DATAROOT,@MSGROOT "RTN","SDHL7CON",116,0) . Q "RTN","SDHL7CON",117,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7CON",118,0) ; "RTN","SDHL7CON",119,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7CON",120,0) ; "RTN","SDHL7CON",121,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7CON",122,0) ; "RTN","SDHL7CON",123,0) D RESET^SDHL7UL ;Clean up TMP used by logging "RTN","SDHL7CON",124,0) K @DATAROOT,@MSGROOT "RTN","SDHL7CON",125,0) ; "RTN","SDHL7CON",126,0) Q "RTN","SDHL7CON",127,0) ; "RTN","SDHL7CON",128,0) VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message "RTN","SDHL7CON",129,0) ; "RTN","SDHL7CON",130,0) ; Messages handled: QBP^Q13 "RTN","SDHL7CON",131,0) ; "RTN","SDHL7CON",132,0) ; QBP query messages must contain QPD and RCP segments "RTN","SDHL7CON",133,0) ; Any additional segments are ignored "RTN","SDHL7CON",134,0) ; "RTN","SDHL7CON",135,0) ; Input: "RTN","SDHL7CON",136,0) ; MSGROOT - Root of array holding message "RTN","SDHL7CON",137,0) ; XMT - Transmission parameters "RTN","SDHL7CON",138,0) ; "RTN","SDHL7CON",139,0) ; Output: "RTN","SDHL7CON",140,0) ; QRY - Query Array "RTN","SDHL7CON",141,0) ; XMT - Transmission parameters "RTN","SDHL7CON",142,0) ; ERR - segment^sequence^field^code^ACK type^error text "RTN","SDHL7CON",143,0) ; "RTN","SDHL7CON",144,0) N MSH,QPD,REQID,REQTYPE,QTAG,QNAME,RDF "RTN","SDHL7CON",145,0) N SEGTYPE,CNT "RTN","SDHL7CON",146,0) K QRY,ERR "RTN","SDHL7CON",147,0) S ERR="" "RTN","SDHL7CON",148,0) ; "RTN","SDHL7CON",149,0) ; Set up basics for responding to message. "RTN","SDHL7CON",150,0) ;----------------------------------------- "RTN","SDHL7CON",151,0) S QRY("MID")=XMT("MID") ;Message ID "RTN","SDHL7CON",152,0) S QRY("QPD")="" "RTN","SDHL7CON",153,0) ; "RTN","SDHL7CON",154,0) ; Validate message is a well-formed QBP query message. "RTN","SDHL7CON",155,0) ;----------------------------------------------------------- "RTN","SDHL7CON",156,0) ; Must have MSH first, followed by QPD,RCP in any order "RTN","SDHL7CON",157,0) ; PID and STF are optional. All other segments are ignored. "RTN","SDHL7CON",158,0) ; "RTN","SDHL7CON",159,0) I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) "RTN","SDHL7CON",160,0) E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 "RTN","SDHL7CON",161,0) ; "RTN","SDHL7CON",162,0) S CNT=2 "RTN","SDHL7CON",163,0) F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 "RTN","SDHL7CON",164,0) . S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7CON",165,0) . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q "RTN","SDHL7CON",166,0) . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q "RTN","SDHL7CON",167,0) . Q "RTN","SDHL7CON",168,0) ; "RTN","SDHL7CON",169,0) I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0 "RTN","SDHL7CON",170,0) ; "RTN","SDHL7CON",171,0) S QTAG=$G(QPD(1,1,2)) ;Query Tag "RTN","SDHL7CON",172,0) S REQID=$G(QPD(2)) ;Request ID "RTN","SDHL7CON",173,0) S REQTYPE=$G(QPD(3,1,1)) ;Request Type "RTN","SDHL7CON",174,0) S:REQTYPE="" REQTYPE=$G(QPD(3)) ;Request Type if no other params "RTN","SDHL7CON",175,0) ; "RTN","SDHL7CON",176,0) ; Validate required fields and query parameters "RTN","SDHL7CON",177,0) ;------------------------------------------------------ "RTN","SDHL7CON",178,0) ; "RTN","SDHL7CON",179,0) ; Check for missing/invalid fields "RTN","SDHL7CON",180,0) ; "RTN","SDHL7CON",181,0) I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0 "RTN","SDHL7CON",182,0) ; "RTN","SDHL7CON",183,0) I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0 "RTN","SDHL7CON",184,0) I REQID="" S ERR="QPD^1^2^101^AE^Missing Request ID" Q 0 "RTN","SDHL7CON",185,0) S (QRY("DCLSNM"),QRY("DFN"))="" "RTN","SDHL7CON",186,0) S QRY("REQID")=REQID "RTN","SDHL7CON",187,0) ; "RTN","SDHL7CON",188,0) I REQTYPE="" S ERR="QPD^1^3^101^AE^Missing Request Type" Q 0 "RTN","SDHL7CON",189,0) ; "RTN","SDHL7CON",190,0) Q 1 "RTN","SDHL7CON",191,0) ; "RTN","SDHL7CON",192,0) LOADXMT(HL,XMT) ;Set HL dependent XMT values "RTN","SDHL7CON",193,0) ; "RTN","SDHL7CON",194,0) ; The HL array and variables are expected to be defined. If not, "RTN","SDHL7CON",195,0) ; message processing will fail. These references should not be "RTN","SDHL7CON",196,0) ; wrapped in $G, as null values will simply postpone the failure to "RTN","SDHL7CON",197,0) ; a point that will be harder to diagnose. Except HL("APAT") which "RTN","SDHL7CON",198,0) ; is not defined on synchronous calls. "RTN","SDHL7CON",199,0) ; "RTN","SDHL7CON",200,0) ; Integration Agreements: "RTN","SDHL7CON",201,0) ; 1373 : Reference to PROTOCOL file #101 "RTN","SDHL7CON",202,0) ; "RTN","SDHL7CON",203,0) N SUBPROT,RESPIEN,RESP0 "RTN","SDHL7CON",204,0) S HL("EID")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7CON",205,0) S HL("EIDS")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Subscriber") "RTN","SDHL7CON",206,0) S XMT("MID")=HL("MID") ;Message ID "RTN","SDHL7CON",207,0) S XMT("MODE")="A" ;Response mode "RTN","SDHL7CON",208,0) I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode "RTN","SDHL7CON",209,0) S XMT("MESSAGE TYPE")=HL("MTN") ;Message type "RTN","SDHL7CON",210,0) S XMT("EVENT TYPE")=HL("ETN") ;Event type "RTN","SDHL7CON",211,0) S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters "RTN","SDHL7CON",212,0) ;S XMT("DELIM")="~^\&" "RTN","SDHL7CON",213,0) S XMT("MAX SIZE")=0 ;Default size unlimited "RTN","SDHL7CON",214,0) ; "RTN","SDHL7CON",215,0) ; Map response protocol and builder "RTN","SDHL7CON",216,0) S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") "RTN","SDHL7CON",217,0) Q "RTN","SDHL7CON",218,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",219,0) N I,J,SITE,SEQ,DIFF,SDSRV,ORLOC,GMRCOER "RTN","SDHL7CON",220,0) S J=1,SEQ="",GMRCOER=2 "RTN","SDHL7CON",221,0) S:'$L($G(SDSDT)) SDSDT="" "RTN","SDHL7CON",222,0) S:'$L($G(SDEDT)) SDEDT="" "RTN","SDHL7CON",223,0) S:'$L($G(SDSERV))!(+$G(SDSERV)=0) SDSERV="" "RTN","SDHL7CON",224,0) S:'$L($G(SDSTATUS)) SDSTATUS="" ;ALL STATI "RTN","SDHL7CON",225,0) K ^TMP("GMRCR",$J) "RTN","SDHL7CON",226,0) S SDY=$NA(^TMP("ORQQCN",$J,"CS")) "RTN","SDHL7CON",227,0) D OER^GMRCSLM1(SDPT,SDSERV,SDSDT,SDEDT,SDSTATUS,GMRCOER) "RTN","SDHL7CON",228,0) M @SDY=^TMP("GMRCR",$J,"CS") "RTN","SDHL7CON",229,0) K @SDY@("AD") "RTN","SDHL7CON",230,0) K @SDY@(0) "RTN","SDHL7CON",231,0) K ^TMP("GMRCR",$J) "RTN","SDHL7CON",232,0) Q "RTN","SDHL7CON",233,0) RTCLIST(SDY,SDPT,SDSDT,SDEDT) ; return patient's "Return to Clinic" appointment requests "RTN","SDHL7CON",234,0) ;SDY = return global "RTN","SDHL7CON",235,0) ;SDPT = dfn of patient "RTN","SDHL7CON",236,0) ;SDSDT = start date (based on CREATE DATE of request) "RTN","SDHL7CON",237,0) ;SDEDT = end date (based on END DATE of request) "RTN","SDHL7CON",238,0) N IDX,IEN,SDEC0,REQDT,CNT,CLINID,CID,STOP,PRVID,CMTS,MRTC,RTCINT,RTCINT,RTCPAR "RTN","SDHL7CON",239,0) S SDY=$NA(^TMP("SDHL7CON",$J,"RTCLIST")) K @SDY "RTN","SDHL7CON",240,0) S SDSDT=$G(SDSDT,"ALL"),SDEDT=$G(SDEDT),CNT=0 "RTN","SDHL7CON",241,0) Q:'$G(SDPT) ; Return nothing if no patient passed "RTN","SDHL7CON",242,0) S IDX=$NA(^SDEC(409.85,"B",SDPT)),IEN=0 "RTN","SDHL7CON",243,0) F S IEN=$O(@IDX@(IEN)) Q:'$G(IEN) D "RTN","SDHL7CON",244,0) . K RTCINT,MRTC,RTCPAR,SDEC0,CLINID,CID,PRVID,CMTS,CLINNM,STOP "RTN","SDHL7CON",245,0) . S SDEC0=$G(^SDEC(409.85,IEN,0)) "RTN","SDHL7CON",246,0) . I $P(SDEC0,U,5)'="RTC" Q "RTN","SDHL7CON",247,0) . I $P(SDEC0,U,17)'="O" Q "RTN","SDHL7CON",248,0) . S REQDT=$P(SDEC0,U,2) I SDSDT'="ALL",$P(REQDT,".",1)SDEDT) Q "RTN","SDHL7CON",249,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",250,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",251,0) . S:$G(RTCPAR)="" RTCPAR=IEN "RTN","SDHL7CON",252,0) . S:$G(MRTC)="" MRTC=0 S:$G(RTCINT)="" RTCINT=0 "RTN","SDHL7CON",253,0) . I +CLINID D "RTN","SDHL7CON",254,0) . . S CLINNM=$$GET1^DIQ(44,CLINID_",",".01") "RTN","SDHL7CON",255,0) . . S STOP=$$GET1^DIQ(44,CLINID_",",8)_","_$$GET1^DIQ(44,CLINID_",",2503) "RTN","SDHL7CON",256,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",257,0) S @SDY=CNT "RTN","SDHL7CON",258,0) Q "RTN","SDHL7CON",259,0) PARSESEG(SEG,DATA,HL) ;Generic segment parser "RTN","SDHL7CON",260,0) ;This procedure parses a single HL7 segment and builds an array "RTN","SDHL7CON",261,0) ;subscripted by the field number containing the data for that field. "RTN","SDHL7CON",262,0) ; Does not handle segments that span nodes "RTN","SDHL7CON",263,0) ; "RTN","SDHL7CON",264,0) ; Input: "RTN","SDHL7CON",265,0) ; SEG - HL7 segment to parse "RTN","SDHL7CON",266,0) ; HL - HL7 environment array "RTN","SDHL7CON",267,0) ; "RTN","SDHL7CON",268,0) ; Output: "RTN","SDHL7CON",269,0) ; Function value - field data array [SUB1:field, SUB2:repetition, "RTN","SDHL7CON",270,0) ; SUB3:component, SUB4:sub-component] "RTN","SDHL7CON",271,0) ; "RTN","SDHL7CON",272,0) N CMP ;component subscript "RTN","SDHL7CON",273,0) N CMPVAL ;component value "RTN","SDHL7CON",274,0) N FLD ;field subscript "RTN","SDHL7CON",275,0) N FLDVAL ;field value "RTN","SDHL7CON",276,0) N REP ;repetition subscript "RTN","SDHL7CON",277,0) N REPVAL ;repetition value "RTN","SDHL7CON",278,0) N SUB ;sub-component subscript "RTN","SDHL7CON",279,0) N SUBVAL ;sub-component value "RTN","SDHL7CON",280,0) N FS ;field separator "RTN","SDHL7CON",281,0) N CS ;component separator "RTN","SDHL7CON",282,0) N RS ;repetition separator "RTN","SDHL7CON",283,0) N SS ;sub-component separator "RTN","SDHL7CON",284,0) ; "RTN","SDHL7CON",285,0) K DATA "RTN","SDHL7CON",286,0) S FS=HL("FS") "RTN","SDHL7CON",287,0) S CS=$E(HL("ECH")) "RTN","SDHL7CON",288,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7CON",289,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7CON",290,0) ; "RTN","SDHL7CON",291,0) S DATA(0)=$P(SEG,FS) "RTN","SDHL7CON",292,0) S SEG=$P(SEG,FS,2,9999) "RTN","SDHL7CON",293,0) ; "RTN","SDHL7CON",294,0) F FLD=1:1:$L(SEG,FS) D "RTN","SDHL7CON",295,0) . S FLDVAL=$P(SEG,FS,FLD) "RTN","SDHL7CON",296,0) . F REP=1:1:$L(FLDVAL,RS) D "RTN","SDHL7CON",297,0) . . S REPVAL=$P(FLDVAL,RS,REP) "RTN","SDHL7CON",298,0) . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D "RTN","SDHL7CON",299,0) . . . S CMPVAL=$P(REPVAL,CS,CMP) "RTN","SDHL7CON",300,0) . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D "RTN","SDHL7CON",301,0) . . . . S SUBVAL=$P(CMPVAL,SS,SUB) "RTN","SDHL7CON",302,0) . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL "RTN","SDHL7CON",303,0) . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL "RTN","SDHL7CON",304,0) . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL "RTN","SDHL7CON",305,0) . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL "RTN","SDHL7CON",306,0) Q "RTN","SDHL7CON",307,0) ; "RTN","SDHL7CON",308,0) LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing "RTN","SDHL7CON",309,0) ; "RTN","SDHL7CON",310,0) ;This subroutine assumes that all VistA HL7 environment variables are "RTN","SDHL7CON",311,0) ;properly initialized and will produce a fatal error if they aren't. "RTN","SDHL7CON",312,0) ; "RTN","SDHL7CON",313,0) N CNT,SEG "RTN","SDHL7CON",314,0) K @MSGROOT "RTN","SDHL7CON",315,0) F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7CON",316,0) . S CNT=0 "RTN","SDHL7CON",317,0) . S @MSGROOT@(SEG,CNT)=HLNODE "RTN","SDHL7CON",318,0) . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) "RTN","SDHL7CON",319,0) Q "RTN","SDHL7CON",320,0) ; "RTN","SDHL7CON",321,0) PARSEMSG(MSGROOT,HL) ; Message Parser "RTN","SDHL7CON",322,0) ; Does not handle segments that span nodes "RTN","SDHL7CON",323,0) ; Does not handle extremely long segments (uses a local) "RTN","SDHL7CON",324,0) ; Does not handle long fields (segment parser doesn't) "RTN","SDHL7CON",325,0) ; "RTN","SDHL7CON",326,0) N SEG,CNT,DATA,MSG "RTN","SDHL7CON",327,0) F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D "RTN","SDHL7CON",328,0) . D PARSESEG(SEG(0),.DATA,.HL) "RTN","SDHL7CON",329,0) . K @MSGROOT@(CNT) "RTN","SDHL7CON",330,0) . I DATA(0)'="" M @MSGROOT@(CNT)=DATA "RTN","SDHL7CON",331,0) . Q:'$D(SEG(1)) "RTN","SDHL7CON",332,0) . ; "RTN","SDHL7CON",333,0) . Q "RTN","SDHL7CON",334,0) Q "RTN","SDHL7CON",335,0) SENDERR(ERR) ; Send for unsuccessful response "RTN","SDHL7CON",336,0) K @MSGROOT "RTN","SDHL7CON",337,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7CON",338,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7CON",339,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",340,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^SDTMBUS(.HL,ERR),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",341,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7CON",342,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7CON",343,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7CON",344,0) Q "RTN","SDHLAPT2") 0^11^B11391953^B22091553 "RTN","SDHLAPT2",1,0) SDHLAPT2 ;MS/PB - VISTA SCHEDULING RPCS ;Nov 14, 2014 "RTN","SDHLAPT2",2,0) ;;5.3;Scheduling;**704,773**;Nov 14, 2018;Build 9 "RTN","SDHLAPT2",3,0) ; "RTN","SDHLAPT2",4,0) Q "RTN","SDHLAPT2",5,0) AIL ; "RTN","SDHLAPT2",6,0) D PARSESEG^SDHL7APU(SEG,.AIL,.HL) "RTN","SDHLAPT2",7,0) S SDCL=+$G(AIL(3,1,1)) N RET,RET1 D RESLKUP^SDHL7APU(SDCL) S SDECRES=RET1 "RTN","SDHLAPT2",8,0) N STCREC,CONSID,MTC "RTN","SDHLAPT2",9,0) S STCREC="" "RTN","SDHLAPT2",10,0) S SDAPTYP="" "RTN","SDHLAPT2",11,0) S (SDPARENT)=$G(AIL(1,4,1,4)) "RTN","SDHLAPT2",12,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",13,0) I $G(AIL(1,4,1,2))="R" D "RTN","SDHLAPT2",14,0) . S MTC=$P($G(^SDEC(409.85,+$G(SDPARENT),3)),"^"),SDMRTC=$S(MTC>0:1,1:0) "RTN","SDHLAPT2",15,0) . ;get the last child sequence number and set RTCID and MSGARY("RTCID") = to last sequence number plus 1 "RTN","SDHLAPT2",16,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",17,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",18,0) . Q "RTN","SDHLAPT2",19,0) ;Get parent rtc order if it is a multi appointment rtc "RTN","SDHLAPT2",20,0) S:$G(AIL(1,4,1,2))="A" SDAPTYP="A|" "RTN","SDHLAPT2",21,0) I $P(PROVAPT(XX+1),"|")="NTE" S SDECNOTE=$P($G(PROVAPT(XX+1)),"|",4) "RTN","SDHLAPT2",22,0) Q "RTN","SDHLAPT2",23,0) ; "RTN","SDHLAPT2",24,0) NEWTIME ;Adjust time for intrafacility appointment "RTN","SDHLAPT2",25,0) N ST1,ST12 "RTN","SDHLAPT2",26,0) S ST12=$P(SDTMPHL(1),"|",12),ST1=$P(ST12,"^",4) "RTN","SDHLAPT2",27,0) S INST=$$INST^SDTMPHLA(AIL(2,3,1,1)) "RTN","SDHLAPT2",28,0) S ST1=$$JSONTFM(ST1,INST) "RTN","SDHLAPT2",29,0) S ST1=$$FMADD^XLFDT(ST1,,,5) ;Add 5 minutes "RTN","SDHLAPT2",30,0) S ST1=$$TMCONV^SDTMPHLA(ST1,INST) "RTN","SDHLAPT2",31,0) S $P(ST12,"^",4)=$G(ST1) "RTN","SDHLAPT2",32,0) S $P(SDTMPHL(1),"|",12)=$G(ST12) "RTN","SDHLAPT2",33,0) S $P(SDTMPHL(5),"|",5)=$P(ST12,"^",4) "RTN","SDHLAPT2",34,0) Q "RTN","SDHLAPT2",35,0) ; "RTN","SDHLAPT2",36,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",37,0) Q:$G(AIL(1,3,1,4))'=$G(AIL(2,3,1,4)) "RTN","SDHLAPT2",38,0) S STOPME=0 "RTN","SDHLAPT2",39,0) N IENS,X1,GMRDFN "RTN","SDHLAPT2",40,0) I $P($G(SDAPTYP),"|",1)="C" D "RTN","SDHLAPT2",41,0) .F X1=1:1:2 D "RTN","SDHLAPT2",42,0) ..Q:$G(STOPME)=1 "RTN","SDHLAPT2",43,0) ..S IENS=+$G(AIL(X1,4,1,1)) "RTN","SDHLAPT2",44,0) ..Q:+$G(IENS)'>0 "RTN","SDHLAPT2",45,0) ..S GMRDFN=$$GET1^DIQ(123,IENS_",",.02,"I","ERR") "RTN","SDHLAPT2",46,0) ..I $G(GMRDFN)'=$G(DFN)!($G(^GMR(123,+$G(IENS),0))="") D "RTN","SDHLAPT2",47,0) ...S ERR="MSA^1^^100^AE^CONSULT ID# "_+$G(IENS)_" IS NOT FOR PATIENT "_$P(^DPT(DFN,0),"^") "RTN","SDHLAPT2",48,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHLAPT2",49,0) ...S STOPME=1 "RTN","SDHLAPT2",50,0) ..Q "RTN","SDHLAPT2",51,0) .Q "RTN","SDHLAPT2",52,0) I $P($G(SDAPTYP),"|",1)="R" D "RTN","SDHLAPT2",53,0) .F X1=1:1:2 D "RTN","SDHLAPT2",54,0) ..Q:$G(STOPME)=1 "RTN","SDHLAPT2",55,0) ..S IENS=+$G(AIL(X1,4,1,1)) "RTN","SDHLAPT2",56,0) ..Q:+$G(IENS)'>0 "RTN","SDHLAPT2",57,0) ..I $G(DFN)'=$P($G(^SDEC(409.85,IENS,0)),"^",1)!($G(^SDEC(409.85,IENS,0))="") D "RTN","SDHLAPT2",58,0) ...S STOPME=1 "RTN","SDHLAPT2",59,0) ...S ERR="MSA^1^^100^AE^RTC ORDER# "_+$P($G(SDAPTYP),"|",2)_" IS NOT FOR PATIENT "_$P(^DPT(DFN,0),"^") "RTN","SDHLAPT2",60,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHLAPT2",61,0) ..Q "RTN","SDHLAPT2",62,0) Q "RTN","SDHLAPT2",63,0) ; "RTN","SDHLAPT2",64,0) CHKCAN(PAT,CLINIC,DATE) ; check to see if the appointment in 44 is canceled correctly. if not cancel it "RTN","SDHLAPT2",65,0) N TIEN,DIK,DA "RTN","SDHLAPT2",66,0) Q:$G(PAT)'>0 "RTN","SDHLAPT2",67,0) Q:$G(CLINIC)'>0 "RTN","SDHLAPT2",68,0) Q:$G(DATE)="" "RTN","SDHLAPT2",69,0) S TIEN=$$SCIEN^SDECU2(PAT,CLINIC,DATE) "RTN","SDHLAPT2",70,0) Q:$G(TIEN)'>0 "RTN","SDHLAPT2",71,0) I $G(TIEN)>0 D "RTN","SDHLAPT2",72,0) .S DIK="^SC("_CLINIC_",""S"","_DATE_",1," "RTN","SDHLAPT2",73,0) .S DA(2)=CLINIC,DA(1)=DATE,DA=TIEN "RTN","SDHLAPT2",74,0) .D ^DIK "RTN","SDHLAPT2",75,0) .K DIK,DA "RTN","SDHLAPT2",76,0) Q "RTN","SDHLAPT2",77,0) ; "RTN","SDHLAPT2",78,0) JSONTFM(DTTM,INST) ;Convert XML/JSON external time to FM format in local timezone. If zulu time, apply timezone difference. 2020-08-28T17:00:00.000Z "RTN","SDHLAPT2",79,0) N DIFF,DATE,TM,SDT,ZULU,TZINST "RTN","SDHLAPT2",80,0) S ZULU=DTTM["Z" "RTN","SDHLAPT2",81,0) S TZINST=$$CHKINST^SDTMPHLA(INST) "RTN","SDHLAPT2",82,0) S DATE=$P(DTTM,"T"),DATE=$TR(DATE,"-",""),DATE=DATE-17000000 "RTN","SDHLAPT2",83,0) S TM=$P(DTTM,"T",2),TM=$P(TM,"."),TM=$TR(TM,":",""),TM=+TM "RTN","SDHLAPT2",84,0) S DIFF=0 I ZULU S DIFF=$P($$UTC^DIUTC(DATE_"."_TM,,TZINST,,1),"^",3) "RTN","SDHLAPT2",85,0) S SDT=$$FMADD^XLFDT(DATE_"."_TM,,$G(DIFF),0) "RTN","SDHLAPT2",86,0) Q SDT "RTN","SDTMBUS") 0^12^B30397594^B30769228 "RTN","SDTMBUS",1,0) SDTMBUS ;MS/TG/MS/PB - TMP HL7 Routine;JULY 05, 2018 "RTN","SDTMBUS",2,0) ;;5.3;Scheduling;**704,773**;May 29, 2018;Build 9 "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,INST "RTN","SDTMBUS",86,0) S FOUND=0,INST=$$KSP^XUPARAM("INST") "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,-730) ;773 increase Consults lookup from 365 to 730 "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^SDTMPHLA(XDT,INST) "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,-730) ;773 increase RTCs lookup from 365 to 730 "RTN","SDTMBUS",159,0) . Q:$G(REQDT)0 S TEXT="NOT A VALID STOP CODE" D MSG(TEXT) G:$G(Y) EDIT I $D(DTOUT)!$D(DUOUT) G EXIT ; Need to add code to give user an error message "RTN","SDTMPEDT",14,0) S X1=$O(^SD(40.6,"B",STOPCODE,"")) "RTN","SDTMPEDT",15,0) D ASK($S(X1>0:"D",1:"A")) I $D(DTOUT)!$D(DUOUT) G EXIT "RTN","SDTMPEDT",16,0) I $G(DEL)="0",($G(ADD)="0") W ! D MSG("Do you want to edit another stop code") G:$G(Y) EDIT I 'Y!$D(DTOUT)!$D(DUOUT) G EXIT "RTN","SDTMPEDT",17,0) D UPD(DEL,STOPCODE) "RTN","SDTMPEDT",18,0) S TEXT=$G(TMPERR) "RTN","SDTMPEDT",19,0) D MSG("Do you want to edit another stop code") G:$G(Y) EDIT I $D(DTOUT)!$D(DUOUT) G EXIT "RTN","SDTMPEDT",20,0) Q "RTN","SDTMPEDT",21,0) UPD(DEL,STOPCODE) ; "RTN","SDTMPEDT",22,0) N FDA "RTN","SDTMPEDT",23,0) I DEL="1" S FDA(40.6,X1_",",.01)="@" "RTN","SDTMPEDT",24,0) E S FDA(40.6,"+1,",.01)=STOPCODE "RTN","SDTMPEDT",25,0) D UPDATE^DIE("","FDA","TMPERR") "RTN","SDTMPEDT",26,0) W !,$C(7),"STOP Code: ",STOPCODE," has been ",$S(DEL=1:"Deleted!",1:"Added!"),! "RTN","SDTMPEDT",27,0) Q "RTN","SDTMPEDT",28,0) ASK(ACT) ; "RTN","SDTMPEDT",29,0) D EX1 "RTN","SDTMPEDT",30,0) S DIR(0)="Y",DIR("A")="This stop code is "_$S(ACT="D":"already",1:"NOT")_" in the file, do you want to "_$S(ACT="D":"delete",1:"add")_" it",DIR("B")="NO" "RTN","SDTMPEDT",31,0) D ^DIR K DIR I Y S:ACT="D" DEL=Y S:ACT="A" ADD=Y "RTN","SDTMPEDT",32,0) Q "RTN","SDTMPEDT",33,0) CHKSTOP(STOPCODE) ; "RTN","SDTMPEDT",34,0) N XX "RTN","SDTMPEDT",35,0) S XX=$O(^DIC(40.7,"C",STOPCODE,"")) ; check to be sure it is valid stop code "RTN","SDTMPEDT",36,0) Q XX "RTN","SDTMPEDT",37,0) EX1 ; "RTN","SDTMPEDT",38,0) K DIR(0),DIR("A"),DIR("?"),DIRUT,DUOUT,DTOUT,DIROUT,X,Y "RTN","SDTMPEDT",39,0) Q "RTN","SDTMPEDT",40,0) EXIT ; "RTN","SDTMPEDT",41,0) K DIR(0),DIR("A"),DIR("?"),DIRUT,DUOUT,DTOUT,DIROUT,X,X1,Y,STOPCODE "RTN","SDTMPEDT",42,0) Q "RTN","SDTMPEDT",43,0) MSG(TEXT) ; give user error message if stop code is not valid "RTN","SDTMPEDT",44,0) D EX1 "RTN","SDTMPEDT",45,0) S DIR(0)="Y",DIR("A")=$G(TEXT),DIR("B")="NO" D ^DIR "RTN","SDTMPEDT",46,0) Q "RTN","SDTMPEDT",47,0) ; "RTN","SDTMPHLA") 0^6^B102974942^B122143881 "RTN","SDTMPHLA",1,0) SDTMPHLA ;MS/PB - TMP HL7 Routine;May 29, 2018 "RTN","SDTMPHLA",2,0) ;;5.3;Scheduling;**704,733,773**;SEP 26, 2018;Build 9 "RTN","SDTMPHLA",3,0) Q "RTN","SDTMPHLA",4,0) ; "RTN","SDTMPHLA",5,0) EN(DFN,APTTM) ; Entry to the routine to build an HL7 message "RTN","SDTMPHLA",6,0) ;notification to TMP about a new appointment in a TeleHealth Clinic "RTN","SDTMPHLA",7,0) ; "RTN","SDTMPHLA",8,0) ;put in check for this to be a telehealth clinic. if not a telehealth clinic quit "RTN","SDTMPHLA",9,0) ;Call API to create MSH segment "RTN","SDTMPHLA",10,0) Q:$G(DFN)="" "RTN","SDTMPHLA",11,0) Q:$G(APTTM)="" "RTN","SDTMPHLA",12,0) N PARMS,SEG,WHOTO,SNODE,ANODE,CNODE,CLINODE,ERROR,MSG,ANODE1 "RTN","SDTMPHLA",13,0) S (SSTOP,PSTOP,STOP)=0 "RTN","SDTMPHLA",14,0) K CLINID "RTN","SDTMPHLA",15,0) S RTN=0,CAN=0 "RTN","SDTMPHLA",16,0) ;Q:'$D(^DPT(DFN,"S",APTTM,0)) "RTN","SDTMPHLA",17,0) S ANODE=$G(^DPT(DFN,"S",APTTM,0)) "RTN","SDTMPHLA",18,0) S ANODE1=$G(^DPT(DFN,"S",APTTM,1)) "RTN","SDTMPHLA",19,0) ;If this appointment was made by the TMP application, stop 773 "RTN","SDTMPHLA",20,0) I $G(MSH(9)),$D(^XTMP("SDTMP",+MSH(9))) Q "RTN","SDTMPHLA",21,0) S CLINID=$P(ANODE,U,1) "RTN","SDTMPHLA",22,0) S CLINODE=$G(^SC(CLINID,0)) "RTN","SDTMPHLA",23,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",24,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",25,0) ;Q:$G(SNODE)="" ; If the appointment is not in the Hospital Location File stop. "RTN","SDTMPHLA",26,0) ;S PSTOP=$P(SNODE,"^",7),SSTOP=$P(SNODE,"^",18) "RTN","SDTMPHLA",27,0) S PSTOP=$P(CLINODE,"^",7),SSTOP=$P(CLINODE,"^",18) "RTN","SDTMPHLA",28,0) ;If both stop codes are null, stop the check, we know it is not a tele health clinic "RTN","SDTMPHLA",29,0) Q:($G(PSTOP)="")&(($G(SSTOP))="") "RTN","SDTMPHLA",30,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",31,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",32,0) I $G(STOP)=0 Q:$G(SSTOP)'>0 S STOP=$$CHKCLIN(SSTOP) ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop ;773 "RTN","SDTMPHLA",33,0) Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic "RTN","SDTMPHLA",34,0) ; need code to stop processing if the appointment was made by TMP "RTN","SDTMPHLA",35,0) I $P($G(ANODE),"^",2)["C" S CAN=1 "RTN","SDTMPHLA",36,0) S SNODE=$G(^SC(CLINID,"S",APTTM,1,1,0)) "RTN","SDTMPHLA",37,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",38,0) S:CAN=0 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S12" "RTN","SDTMPHLA",39,0) S:CAN=1 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S15" "RTN","SDTMPHLA",40,0) I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) Q 0 "RTN","SDTMPHLA",41,0) S SEQ=1 "RTN","SDTMPHLA",42,0) D:CAN=0 SCH(DFN,SEQ,.SEG,$G(ANODE),$G(SNODE)) "RTN","SDTMPHLA",43,0) I (CAN=0&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0 "RTN","SDTMPHLA",44,0) D:CAN=1 SCHCAN(DFN,SEQ,.SEG,$G(ANODE),$G(SNODE),$G(CNODE)) "RTN","SDTMPHLA",45,0) I (CAN=1&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0 "RTN","SDTMPHLA",46,0) D NTE(.SEQ,.SEG) "RTN","SDTMPHLA",47,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",48,0) D PID(DFN,SEQ,.SEG) "RTN","SDTMPHLA",49,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",50,0) D PV1(DFN,SEQ,.SEG) "RTN","SDTMPHLA",51,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",52,0) D RGS1("A",SEQ,.SEG) ;required segment "RTN","SDTMPHLA",53,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",54,0) D AIL1(ANODE,SEQ,.SEG) "RTN","SDTMPHLA",55,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",56,0) S PARMS("SENDING APPLICATION")="TMP_OUT" "RTN","SDTMPHLA",57,0) S PARMS("APP ACK TYPE")="AL" "RTN","SDTMPHLA",58,0) S WHOTO("RECEIVING APPLICATION")="TMP VIMT" "RTN","SDTMPHLA",59,0) S WHOTO("FACILITY LINK NAME")="TMP_SEND" "RTN","SDTMPHLA",60,0) S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0)) "RTN","SDTMPHLA",61,0) S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR) "RTN","SDTMPHLA",62,0) K CAN,APTSTATUS,SSTOP,PSTOP,STOP,CLINID,PROVID,PROVNM,XX "RTN","SDTMPHLA",63,0) Q RTN "RTN","SDTMPHLA",64,0) PID(DFN,SEQ,SEG) ; "RTN","SDTMPHLA",65,0) N VA,VADM,VAHOW,VAROOT,VATEST,VAPA,NAME,DOB,SSN,ICN,ADDRESS "RTN","SDTMPHLA",66,0) K SEG S SEG="" "RTN","SDTMPHLA",67,0) S VAHOW=1 "RTN","SDTMPHLA",68,0) D DEM^VADPT "RTN","SDTMPHLA",69,0) S NAME=VADM("NM") D STDNAME^XLFNAME(.NAME,"C") "RTN","SDTMPHLA",70,0) S DOB=$P(VADM("DB"),"^"),SSN=$P(VADM("SS"),"^") "RTN","SDTMPHLA",71,0) S VAHOW="" "RTN","SDTMPHLA",72,0) D ADD^VADPT "RTN","SDTMPHLA",73,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",74,0) S ICN=$$GETICN^MPIF001(DFN) "RTN","SDTMPHLA",75,0) D SET^HLOAPI(.SEG,"PID",0) ; Set segment type to PID "RTN","SDTMPHLA",76,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set PID-1 "RTN","SDTMPHLA",77,0) ; set ICN into PID-3, repitition 1 "RTN","SDTMPHLA",78,0) D SET^HLOAPI(.SEG,+ICN,3,1,1,1) ; Component 1, subcomponent 1, Patient ICN "RTN","SDTMPHLA",79,0) D SET^HLOAPI(.SEG,$P(ICN,"V",2),3,2,1,1) ; Component 1, subcomponent 2, Patient ICN checksum "RTN","SDTMPHLA",80,0) D SET^HLOAPI(.SEG,DFN,4,1,1,1) ; patient DFN "RTN","SDTMPHLA",81,0) D SET^HLOAPI(.SEG,"USVHA",3,4,1,1) ; component 4, subcomponent1 "RTN","SDTMPHLA",82,0) D SET^HLOAPI(.SEG,"0363",3,5,1,1) ; component 5 "RTN","SDTMPHLA",83,0) ; set SSN into PID-3, repetition 2 "RTN","SDTMPHLA",84,0) D SET^HLOAPI(.SEG,SSN,3,1,1,2) ;component 1, subcomponent1 "RTN","SDTMPHLA",85,0) D SET^HLOAPI(.SEG,"USSSA",3,4,1,2) ; Component 4, subcomponent 1 "RTN","SDTMPHLA",86,0) D SET^HLOAPI(.SEG,"0363",3,4,3,2) ; component 4, subcomponent 3 "RTN","SDTMPHLA",87,0) D SET^HLOAPI(.SEG,"SS",3,5,1,2) ; component 1 "RTN","SDTMPHLA",88,0) ;Set the name inot PID-5 "RTN","SDTMPHLA",89,0) D SETXPN^HLOAPI4(.SEG,.NAME,5) "RTN","SDTMPHLA",90,0) ; Set the DOB into PID-7 "RTN","SDTMPHLA",91,0) D SETDT^HLOAPI4(.SEG,DOB,7) "RTN","SDTMPHLA",92,0) ; set the address into PID-11 "RTN","SDTMPHLA",93,0) D SETAD^HLOAPI4(.SEG,.ADDRESS,11) "RTN","SDTMPHLA",94,0) Q "RTN","SDTMPHLA",95,0) PD1 ; Not needed right now "RTN","SDTMPHLA",96,0) Q "RTN","SDTMPHLA",97,0) PV1(DFN,SEQ,SEG) ; "RTN","SDTMPHLA",98,0) N FAC "RTN","SDTMPHLA",99,0) S CLASS="OUTPATIENT" "RTN","SDTMPHLA",100,0) S FAC=$$KSP^XUPARAM("INST") "RTN","SDTMPHLA",101,0) D SET^HLOAPI(.SEG,"PV1",0) ; Set the segment type "RTN","SDTMPHLA",102,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the PV1-1 "RTN","SDTMPHLA",103,0) ; set the PV1-2, patient class (tbl 5-20 in the TMP HL7 specification "RTN","SDTMPHLA",104,0) D SET^HLOAPI(.SEG,CLASS,2) ; "RTN","SDTMPHLA",105,0) ; set the PV1-4, Purpose of Visit "RTN","SDTMPHLA",106,0) D SET^HLOAPI(.SEG,APTSTATUS,4) "RTN","SDTMPHLA",107,0) ; set the PV1-7, provider "RTN","SDTMPHLA",108,0) D SET^HLOAPI(.SEG,$G(PROVID),7,1,1) "RTN","SDTMPHLA",109,0) D SET^HLOAPI(.SEG,$G(PROVNM),7,2,1) "RTN","SDTMPHLA",110,0) ; set the PV1-39 facility id "RTN","SDTMPHLA",111,0) D SET^HLOAPI(.SEG,FAC,39) "RTN","SDTMPHLA",112,0) K CLASS "RTN","SDTMPHLA",113,0) Q "RTN","SDTMPHLA",114,0) SCH(DFN,SEQ,SEG,ANODE,SNODE) ; update for new appointments "RTN","SDTMPHLA",115,0) N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,CONNM,PREMAIL,END "RTN","SDTMPHLA",116,0) ;S LENGTH=$P(^SC(CLINID,"SL"),"^",1),TMUNITS="M" "RTN","SDTMPHLA",117,0) S:$G(SNODE)'="" LENGTH=$P($G(SNODE),"^",2) "RTN","SDTMPHLA",118,0) S TMUNITS="M" "RTN","SDTMPHLA",119,0) S:$G(LENGTH)="" LENGTH=$G(SDECC("LEN")) "RTN","SDTMPHLA",120,0) S START=$$TMCONV(APTTM,$$INST(CLINID)),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END,$$INST(CLINID)) "RTN","SDTMPHLA",121,0) S:$G(CNODE)>0 CONNM=$P(^GMR(123.5,$P(^GMR(123,CNODE,0),"^",5),0),"^") "RTN","SDTMPHLA",122,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",123,0) K XS S (STATUS("ID"))=$S($P(ANODE,"^",2)="":"S",1:$P(ANODE,"^",2)) S:STATUS("ID")="S" STATUS("TEXT")="SCHEDULED" "RTN","SDTMPHLA",124,0) N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID")) "RTN","SDTMPHLA",125,0) S STATUS("SYSTEM")=2 "RTN","SDTMPHLA",126,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",127,0) S:$G(SNODE)'="" ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1) "RTN","SDTMPHLA",128,0) S:$G(SNODE)="" ENTEREDBY=$P(^VA(200,$G(DUZ),0),"^"),SCHEMAIL=$P($G(^VA(200,$G(DUZ),.15)),"^",1) "RTN","SDTMPHLA",129,0) D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type "RTN","SDTMPHLA",130,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1 "RTN","SDTMPHLA",131,0) D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status "RTN","SDTMPHLA",132,0) D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request "RTN","SDTMPHLA",133,0) ;D:$G(CONNM)'="" SET^HLOAPI(.SEG,CONNM,7,2) ;Consult name "RTN","SDTMPHLA",134,0) D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length "RTN","SDTMPHLA",135,0) D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units "RTN","SDTMPHLA",136,0) D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",137,0) D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",138,0) D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz "RTN","SDTMPHLA",139,0) D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name "RTN","SDTMPHLA",140,0) D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail "RTN","SDTMPHLA",141,0) D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment "RTN","SDTMPHLA",142,0) D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email "RTN","SDTMPHLA",143,0) D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment "RTN","SDTMPHLA",144,0) Q "RTN","SDTMPHLA",145,0) SCHCAN(DFN,SEQ,SEG,ANODE,SNODE,CNODE) ; update for cancelled appointments "RTN","SDTMPHLA",146,0) N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,PREMAIL,END "RTN","SDTMPHLA",147,0) Q:$G(SNODE)="" ;SNODE=SNODE=$G(^SC(CLINID,"S",APTTM,1,XX,0)) "RTN","SDTMPHLA",148,0) S:$G(DUZ)="" DUZ=.5 "RTN","SDTMPHLA",149,0) S:$G(DUZ(2))="" DUZ=$$KSP^XUPARAM("SITE") "RTN","SDTMPHLA",150,0) S LENGTH=$P(^SC(CLINID,"SL"),"^",1),TMUNITS="M" "RTN","SDTMPHLA",151,0) S START=$$TMCONV(APTTM,$$INST(CLINID)),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END,$$INST(CLINID)) "RTN","SDTMPHLA",152,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",153,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",154,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",155,0) N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID")) "RTN","SDTMPHLA",156,0) S STATUS("SYSTEM")=2 "RTN","SDTMPHLA",157,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",158,0) S ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1) "RTN","SDTMPHLA",159,0) D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type "RTN","SDTMPHLA",160,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1 "RTN","SDTMPHLA",161,0) D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status "RTN","SDTMPHLA",162,0) D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request "RTN","SDTMPHLA",163,0) ;D:$G(CONNM)'="" SET^HLOAPI(.SEG,CONNM,7,2) ;Consult name "RTN","SDTMPHLA",164,0) D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length "RTN","SDTMPHLA",165,0) D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units "RTN","SDTMPHLA",166,0) D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",167,0) D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",168,0) D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz "RTN","SDTMPHLA",169,0) D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name "RTN","SDTMPHLA",170,0) D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail "RTN","SDTMPHLA",171,0) D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment "RTN","SDTMPHLA",172,0) D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email "RTN","SDTMPHLA",173,0) D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment "RTN","SDTMPHLA",174,0) K SCHEMAIL "RTN","SDTMPHLA",175,0) Q "RTN","SDTMPHLA",176,0) PV2 ; Not needed right now "RTN","SDTMPHLA",177,0) Q "RTN","SDTMPHLA",178,0) OBX1 ; Not needed right now "RTN","SDTMPHLA",179,0) Q "RTN","SDTMPHLA",180,0) OBX2 ; Not needed right now "RTN","SDTMPHLA",181,0) Q "RTN","SDTMPHLA",182,0) OBX3 ; Not needed right now "RTN","SDTMPHLA",183,0) Q "RTN","SDTMPHLA",184,0) OBX4 ; Not needed right now "RTN","SDTMPHLA",185,0) Q "RTN","SDTMPHLA",186,0) RGS1(FLAG,SEQ,SEG) ; At least one RGS segment is required "RTN","SDTMPHLA",187,0) N GRP "RTN","SDTMPHLA",188,0) S GRP="" "RTN","SDTMPHLA",189,0) D SET^HLOAPI(.SEG,"RGS",0) "RTN","SDTMPHLA",190,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",191,0) D SET^HLOAPI(.SEG,FLAG,2) "RTN","SDTMPHLA",192,0) D SET^HLOAPI(.SEG,GRP,3) "RTN","SDTMPHLA",193,0) Q "RTN","SDTMPHLA",194,0) AIS1 ; "RTN","SDTMPHLA",195,0) Q "RTN","SDTMPHLA",196,0) NTE(SEQ,SEG) ; "RTN","SDTMPHLA",197,0) N NOTES,CLINID,CLINNM "RTN","SDTMPHLA",198,0) S NOTES="THESE ARE BOOKING NOTES",CLINID=23,CLINNM="GENERAL MEDICINE" "RTN","SDTMPHLA",199,0) D SET^HLOAPI(.SEG,"NTE",0) "RTN","SDTMPHLA",200,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",201,0) D SET^HLOAPI(.SEG,"NOTES",3) "RTN","SDTMPHLA",202,0) D SET^HLOAPI(.SEG,NOTES,4) "RTN","SDTMPHLA",203,0) Q "RTN","SDTMPHLA",204,0) AIL1(ANODE,SEQ,SEG) ; "RTN","SDTMPHLA",205,0) K LOC "RTN","SDTMPHLA",206,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",207,0) D SET^HLOAPI(.SEG,"AIL",0) "RTN","SDTMPHLA",208,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",209,0) D SET^HLOAPI(.SEG,CODE,2) "RTN","SDTMPHLA",210,0) D SETCE^HLOAPI4(.SEG,.LOC,4) "RTN","SDTMPHLA",211,0) K LOC,CODE "RTN","SDTMPHLA",212,0) Q "RTN","SDTMPHLA",213,0) TMCONV(X,INST) ;Uses division/institution to determine tz instead of mailman files / 773 "RTN","SDTMPHLA",214,0) ;convert FileMan local time to Zulu timezone in JSON format: YYYY-MM-DDTHH:MM:00.000Z "RTN","SDTMPHLA",215,0) ;Inputs: "RTN","SDTMPHLA",216,0) ; X = Time "RTN","SDTMPHLA",217,0) ; INST = Institution "RTN","SDTMPHLA",218,0) ;Output: "RTN","SDTMPHLA",219,0) ; Zulu Time in JSON format "RTN","SDTMPHLA",220,0) N OFFSET,UTC,UTC1,UTC2 "RTN","SDTMPHLA",221,0) S OFFSET=$P($$UTC^DIUTC(X,,$G(INST),,1),"^",3) "RTN","SDTMPHLA",222,0) S UTC=$$FMADD^XLFDT(X,,-$G(OFFSET),,),UTC1=$$FMTHL7^XLFDT(UTC) "RTN","SDTMPHLA",223,0) S UTC2=$E(UTC1,1,4)_"-"_$E(UTC1,5,6)_"-"_$E(UTC1,7,8)_"T"_$E(UTC1,9,10)_":"_$E(UTC1,11,12)_":00.000Z" "RTN","SDTMPHLA",224,0) Q UTC2 "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 STOP "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) ; "RTN","SDTMPHLA",247,0) INST(CLNC) ;Derives the institution value for the clinic "RTN","SDTMPHLA",248,0) ;Inputs: "RTN","SDTMPHLA",249,0) ; CLNC = Clinic IEN from the Hospital Location (#44) file "RTN","SDTMPHLA",250,0) ;Output: "RTN","SDTMPHLA",251,0) ; INST = Institution IEN from the Institution (#4) file. Null indicates an error. "RTN","SDTMPHLA",252,0) I CLNC="" Q "" "RTN","SDTMPHLA",253,0) N DIV,INST,MCD0,NEWINST,TZ "RTN","SDTMPHLA",254,0) S MCD0=$G(^SC(CLNC,0)) "RTN","SDTMPHLA",255,0) I MCD0="" Q "" ;No entry in the Hospital Location (#44) file "RTN","SDTMPHLA",256,0) S INST=$P(MCD0,U,4) "RTN","SDTMPHLA",257,0) I INST S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST "RTN","SDTMPHLA",258,0) S DIV=$P(MCD0,U,15) I 'DIV Q "" "RTN","SDTMPHLA",259,0) S INST=$P($G(^DG(40.8,DIV,0)),U,7) "RTN","SDTMPHLA",260,0) S NEWINST=$$CHKINST(INST) "RTN","SDTMPHLA",261,0) Q NEWINST "RTN","SDTMPHLA",262,0) ; "RTN","SDTMPHLA",263,0) CHKINST(INST) ;Derives the parent institution if the passed-in institution does not have a time zone "RTN","SDTMPHLA",264,0) I 'INST Q "" "RTN","SDTMPHLA",265,0) N TZ,AS "RTN","SDTMPHLA",266,0) S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST "RTN","SDTMPHLA",267,0) S AS=$O(^DIC(4,INST,7,"B",2,"")) I AS S INST=$P(^DIC(4,INST,7,AS,0),U,2) "RTN","SDTMPHLA",268,0) I INST S TZ=$P($G(^DIC(4,INST,8)),U,1) "RTN","SDTMPHLA",269,0) I TZ Q INST "RTN","SDTMPHLA",270,0) Q "" ;Never found an institution with a timezone "RTN","SDTMPHLB") 0^7^B48918000^B49206764 "RTN","SDTMPHLB",1,0) SDTMPHLB ;MS/PB - TMP HL7 Routine;MAY 29, 2018 "RTN","SDTMPHLB",2,0) ;;5.3;Scheduling;**704,733,714,773**;May 29, 2018;Build 9 "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) I $G(STOP)=0 Q:$G(SSTOP)'>0 S STOP=$$CHKCLIN^SDTMPHLA(SSTOP) ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop "RTN","SDTMPHLB",17,0) Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic "RTN","SDTMPHLB",18,0) N PARMS,SEG,WHOTO,ERROR,SEQ "RTN","SDTMPHLB",19,0) S PARMS("MESSAGE TYPE")="MFN",PARMS("EVENT")="M05" "RTN","SDTMPHLB",20,0) I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) W !,"ERR= "_$G(ERROR) Q 0 "RTN","SDTMPHLB",21,0) S SEQ=1 "RTN","SDTMPHLB",22,0) N % D NOW^%DTC S UPDTTM=$$TMCONV^SDTMPHLA(%,$$INST^SDTMPHLA(CLINID)) "RTN","SDTMPHLB",23,0) K CLIN,IEN S IEN=CLINID_"," D CLINDATA(IEN) "RTN","SDTMPHLB",24,0) D MFI(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",25,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) W !,"NOT ADDED "_$G(ERROR)_" " Q 0 "RTN","SDTMPHLB",26,0) D MFE(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",27,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",28,0) D LOC(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",29,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",30,0) D NTE(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",31,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",32,0) D LDP(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",33,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",34,0) D ZDP(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",35,0) I $D(SEG),'$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLB",36,0) D ZPU(CLINID,SEQ,.SEG) "RTN","SDTMPHLB",37,0) S PARMS("SENDING APPLICATION")="TMP_OUT" "RTN","SDTMPHLB",38,0) S WHOTO("RECEIVING APPLICATION")="TMP VIMT" "RTN","SDTMPHLB",39,0) S WHOTO("FACILITY LINK NAME")="TMP_SEND" "RTN","SDTMPHLB",40,0) S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0)) "RTN","SDTMPHLB",41,0) S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR) "RTN","SDTMPHLB",42,0) K CLINID,LOC "RTN","SDTMPHLB",43,0) Q RTN "RTN","SDTMPHLB",44,0) MFI(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",45,0) N APPID "RTN","SDTMPHLB",46,0) D SET^HLOAPI(.SEG,"MFI",0) ; Set the segment type "RTN","SDTMPHLB",47,0) ;D SET^HLOAPI(.SEG,"MFI",0) ; Set segment type to MFI "RTN","SDTMPHLB",48,0) D SET^HLOAPI(.SEG,CLINID,1) ; Set CLINIC ID "RTN","SDTMPHLB",49,0) S APPID="44^HOSPITAL LOCATION" "RTN","SDTMPHLB",50,0) D SET^HLOAPI(.SEG,APPID,2) ; File to be updated "RTN","SDTMPHLB",51,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",52,0) D SET^HLOAPI(.SEG,UPDTTM,4) ; date/time the update occurred "RTN","SDTMPHLB",53,0) D SET^HLOAPI(.SEG,UPDTTM,5) ; effective date/time "RTN","SDTMPHLB",54,0) D SET^HLOAPI(.SEG,"AL",6) ; response level code, this is set to AL for ALWAYS "RTN","SDTMPHLB",55,0) Q "RTN","SDTMPHLB",56,0) MFE(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",57,0) N TYPE "RTN","SDTMPHLB",58,0) D SET^HLOAPI(.SEG,"MFE",0) ; Set the segment type "RTN","SDTMPHLB",59,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",60,0) D SET^HLOAPI(.SEG,TYPE,1) ; type of action "RTN","SDTMPHLB",61,0) D SET^HLOAPI(.SEG,CLINID,2) ; Clinic IEN from the Hospital Location file "RTN","SDTMPHLB",62,0) D SET^HLOAPI(.SEG,UPDTTM,3) "RTN","SDTMPHLB",63,0) D SET^HLOAPI(.SEG,CLINID,4) "RTN","SDTMPHLB",64,0) D SET^HLOAPI(.SEG,"CE",5) ; Primary key value type, this will always be CE "RTN","SDTMPHLB",65,0) Q "RTN","SDTMPHLB",66,0) LOC(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",67,0) N INSTNUM,VISN,STATNUM,CLINNM,DIV,DIV1,DIV2,DIV3 "RTN","SDTMPHLB",68,0) K LOC "RTN","SDTMPHLB",69,0) S CLINNM=CLIN(44,CLINID_",",.01,"E"),STATNUM=$G(CLIN(44,CLINID_",",3,"I")) "RTN","SDTMPHLB",70,0) ;Patch 714 PB - 11/07/19 Add division id to HL7 message "RTN","SDTMPHLB",71,0) S DIV1=$$GET1^DIQ(44,CLINID_",",3.5,"I") S:$G(DIV1)>0 DIV2=$P(^DG(40.8,$G(DIV1),0),"^",7) S:$G(DIV2)>0 DIV3=$$GET1^DIQ(4,DIV2_",",99,"E") "RTN","SDTMPHLB",72,0) D SET^HLOAPI(.SEG,"LOC",0) ; Set the segment type "RTN","SDTMPHLB",73,0) D SET^HLOAPI(.SEG,CLINID,1) ; IEN from the Hospital Location file "RTN","SDTMPHLB",74,0) D SET^HLOAPI(.SEG,CLINNM,2) ; .01 from the Hospital Location file for the clinic "RTN","SDTMPHLB",75,0) D SET^HLOAPI(.SEG,"C",3) ; location type, this will always be C for clinic "RTN","SDTMPHLB",76,0) S INSTNUM=$$KSP^XUPARAM("INST"),INSTNUM=$P(^DIC(4,INSTNUM,99),"^") "RTN","SDTMPHLB",77,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",78,0) ; Need to change how LOC is used to set the data on the LOC segment. this is causing problems "RTN","SDTMPHLB",79,0) S LOC=$G(CLINNM)_"^"_INSTNUM_"^^^"_$G(VISN)_"^"_$G(STATNUM) "RTN","SDTMPHLB",80,0) D SET^HLOAPI(.SEG,$G(CLINNM),4,1) ; Clinic name "RTN","SDTMPHLB",81,0) D SET^HLOAPI(.SEG,$G(INSTNUM),4,2) ; institution number "RTN","SDTMPHLB",82,0) D SET^HLOAPI(.SEG,$G(VISN),4,5) ; visn "RTN","SDTMPHLB",83,0) D SET^HLOAPI(.SEG,$G(DIV3),4,3) ; station number Patch 714 PB 11/07/19 division id as station number "RTN","SDTMPHLB",84,0) Q "RTN","SDTMPHLB",85,0) NTE(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",86,0) ;only one NTE per message. has the clinic start time and number of overbooks per day "RTN","SDTMPHLB",87,0) N CLINSTRT,OVERBK "RTN","SDTMPHLB",88,0) S CLINSTRT=CLIN(44,CLINID_",",1914,"E"),OVERBK=CLIN(44,CLINID_",",1918,"E") "RTN","SDTMPHLB",89,0) D SET^HLOAPI(.SEG,"NTE",0) "RTN","SDTMPHLB",90,0) D SET^HLOAPI(.SEG,1,1) "RTN","SDTMPHLB",91,0) D SET^HLOAPI(.SEG,$G(CLINSTRT),2) "RTN","SDTMPHLB",92,0) D SET^HLOAPI(.SEG,$G(OVERBK),3) "RTN","SDTMPHLB",93,0) Q "RTN","SDTMPHLB",94,0) LDP(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",95,0) N LS,TSPEC,PSTOP,SSTOP,PSNM,CSNM,ACT "RTN","SDTMPHLB",96,0) D ACT "RTN","SDTMPHLB",97,0) S LS=CLIN(44,CLINID_",",9,"E") "RTN","SDTMPHLB",98,0) S TSPEC=CLIN(44,CLINID_",",9.5,"E") "RTN","SDTMPHLB",99,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",100,0) S:$G(PSTOP)>0 PSTOP=$$GET1^DIQ(40.7,PSTOP_",",1,"I") "RTN","SDTMPHLB",101,0) S:$G(SSTOP)>0 SSTOP=$$GET1^DIQ(40.7,SSTOP_",",1,"I") "RTN","SDTMPHLB",102,0) D SET^HLOAPI(.SEG,"LDP",0) "RTN","SDTMPHLB",103,0) D SET^HLOAPI(.SEG,CLINID,1) "RTN","SDTMPHLB",104,0) ;NEED TO CHANGE THE SEGMENT FIELD SET BELOW TO SET INTO THE SUB FIELDS CORRECTLY "RTN","SDTMPHLB",105,0) D SET^HLOAPI(.SEG,LOC,2) "RTN","SDTMPHLB",106,0) D SET^HLOAPI(.SEG,$G(LS),3) "RTN","SDTMPHLB",107,0) D SET^HLOAPI(.SEG,$G(TSPEC),4) "RTN","SDTMPHLB",108,0) D SET^HLOAPI(.SEG,$G(ACT),6) "RTN","SDTMPHLB",109,0) D SET^HLOAPI(.SEG,$G(ACTDT),7) ; reactivation date "RTN","SDTMPHLB",110,0) D SET^HLOAPI(.SEG,$G(INACTDT),8) ; inactivation date "RTN","SDTMPHLB",111,0) D SET^HLOAPI(.SEG,"UNK",9) "RTN","SDTMPHLB",112,0) ; change the line below to use HLO to set up the field and sub fields don't do manually "RTN","SDTMPHLB",113,0) D SET^HLOAPI(.SEG,$G(PSTOP)_"^"_$G(PSNM)_"^CLINIC STOP^"_$G(SSTOP)_"^"_$G(CSNM),12) ;STOP CODES "RTN","SDTMPHLB",114,0) Q "RTN","SDTMPHLB",115,0) ZPU(CLINID,SEQ,SEG) ; "RTN","SDTMPHLB",116,0) N XX,SEQA "RTN","SDTMPHLB",117,0) ; Need code to loop thru the privileged users and add a segment for each privileged user "RTN","SDTMPHLB",118,0) S XX=0,SEQA=1 F S XX=$O(^SC(CLINID,"SDPRIV",XX)) Q:XX'>0 D "RTN","SDTMPHLB",119,0) .N CIEN S CIEN=+$P(^SC(CLINID,"SDPRIV",XX,0),"^") "RTN","SDTMPHLB",120,0) .Q:$G(CIEN)'>0 "RTN","SDTMPHLB",121,0) .N CLERKNM,CLERKEMAIL,CVPID "RTN","SDTMPHLB",122,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",123,0) .I $G(CLERKNM)'="",$G(CLERKEMAIL)="" S CLERKEMAIL="UNK" "RTN","SDTMPHLB",124,0) .S:$G(CVPID)="" CVPID="0" "RTN","SDTMPHLB",125,0) .D SET^HLOAPI(.SEG,"ZPU",0) "RTN","SDTMPHLB",126,0) .D SET^HLOAPI(.SEG,SEQA,1) "RTN","SDTMPHLB",127,0) .D SET^HLOAPI(.SEG,CLERKNM,2) "RTN","SDTMPHLB",128,0) .D SET^HLOAPI(.SEG,CLERKEMAIL,3) "RTN","SDTMPHLB",129,0) .D SET^HLOAPI(.SEG,CVPID,4) "RTN","SDTMPHLB",130,0) .S SEQA=$G(SEQA)+1 "RTN","SDTMPHLB",131,0) .I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q "RTN","SDTMPHLB",132,0) Q "RTN","SDTMPHLB",133,0) ZDP(CLINID,SEQ,SEG) ; has the default provider duz, default provider name and default provider email "RTN","SDTMPHLB",134,0) ;default provider duz comes from the Clinic in file 44. provider name and email from file 2 "RTN","SDTMPHLB",135,0) K PROVDUZ,PROVNM,PROVEMAIL,VPID "RTN","SDTMPHLB",136,0) ;S PROVNM="BURKHALTER,PHIL",PROVEMAIL="phil.burkhalter@anymail.com",VPID="123245V123" "RTN","SDTMPHLB",137,0) S PROVDUZ=CLIN(44,CLINID_",",16,"I"),PROVNM=CLIN(44,CLINID_",",16,"E") "RTN","SDTMPHLB",138,0) S PROVEMAIL="",VPID="" "RTN","SDTMPHLB",139,0) I $G(PROVDUZ)>0 S PROVEMAIL=$$GET1^DIQ(200,PROVDUZ_",",.151,"E","SDTMPERR"),VPID=$$GET1^DIQ(200,PROVDUZ_",",9000,"I","SDTMPERR") "RTN","SDTMPHLB",140,0) S:$G(PROVEMAIL)="" PROVEMAIL="UNK" "RTN","SDTMPHLB",141,0) S:$G(VPID)="" VPID="0" "RTN","SDTMPHLB",142,0) D SET^HLOAPI(.SEG,"ZDP",0) "RTN","SDTMPHLB",143,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLB",144,0) D SET^HLOAPI(.SEG,$G(PROVNM),2) "RTN","SDTMPHLB",145,0) D SET^HLOAPI(.SEG,$G(PROVEMAIL),3) "RTN","SDTMPHLB",146,0) D SET^HLOAPI(.SEG,$G(VPID),4) "RTN","SDTMPHLB",147,0) K PROVNM,PROVEMAIL,VPID "RTN","SDTMPHLB",148,0) Q "RTN","SDTMPHLB",149,0) CLINDATA(CLINID) ; get the clinic data, add code to pull the data from file 44 and 200 "RTN","SDTMPHLB",150,0) N FLDS "RTN","SDTMPHLB",151,0) Q:$G(CLINID)'>0 "RTN","SDTMPHLB",152,0) S IEN=CLINID_",",FLDS=".01;3;8;9;9.5;16;1914;1918;2503;2505;2506" "RTN","SDTMPHLB",153,0) D GETS^DIQ(44,IEN,FLDS,"IE","CLIN","TMPERR") "RTN","SDTMPHLB",154,0) Q "RTN","SDTMPHLB",155,0) VISN(INSTNUM) ; "RTN","SDTMPHLB",156,0) N IEN,VISNPTR "RTN","SDTMPHLB",157,0) S VISN=0 "RTN","SDTMPHLB",158,0) S IEN=$$IEN^XUAF4(INSTNUM) "RTN","SDTMPHLB",159,0) S:$G(IEN)>0 VISNPTR=$P(^DIC(4,IEN,7,1,0),"^",2) "RTN","SDTMPHLB",160,0) I $G(VISNPTR)>0 D "RTN","SDTMPHLB",161,0) .S VISN=$P($G(^DIC(4,VISNPTR,0)),"^",1) "RTN","SDTMPHLB",162,0) .S VISN=$P(VISN," ",2) "RTN","SDTMPHLB",163,0) Q VISN "RTN","SDTMPHLB",164,0) ACT ; "RTN","SDTMPHLB",165,0) N INACTDT,ACTDT "RTN","SDTMPHLB",166,0) S INACTDT=CLIN(44,CLINID_",",2505,"I") "RTN","SDTMPHLB",167,0) I INACTDT="" S ACT="A" "RTN","SDTMPHLB",168,0) I INACTDT'="" D "RTN","SDTMPHLB",169,0) .S ACT="I" "RTN","SDTMPHLB",170,0) .S ACTDT=CLIN(44,CLINID_",",2506,"I") "RTN","SDTMPHLB",171,0) .I ACTDT>INACTDT S ACT="A" "RTN","SDTMPHLB",172,0) Q "RTN","SDTMPUT0") 0^8^B44563014^n/a "RTN","SDTMPUT0",1,0) SDTMPUT0 ;MS/SJA - TELEHEALTH SEARCH UTILITY ;Dec 17, 2020 "RTN","SDTMPUT0",2,0) ;;5.3;Scheduling;**773**;Aug 13, 1993;Build 9 "RTN","SDTMPUT0",3,0) ; "RTN","SDTMPUT0",4,0) ; "RTN","SDTMPUT0",5,0) N II,ARR,CNT,CODE,DFN,FAC,F407,S407,ICNHA,SIEN,MPI,NODE1,NODE8,NODE99,FICN,SDCL,NODE0,DIV,MCD,INST,INSF "RTN","SDTMPUT0",6,0) N LTZ,SDASH,CTRY,TZEX,SDSL,SDRE,SDIN,SDNO,STP1,STP2,OPT,VADM,XX,ZD "RTN","SDTMPUT0",7,0) S $P(SDASH,"=",80)="" "RTN","SDTMPUT0",8,0) EN W @IOF W ?22,"Telehealth Inquiries",!! "RTN","SDTMPUT0",9,0) K DIRUT,DUOUT,DIR "RTN","SDTMPUT0",10,0) S DIR(0)="SA^C:Clinic;M:Medical Center Division;I:Institution;P:Patient Information;L:List Stop codes;S:Stop Code Lookup;Q:QUIT" "RTN","SDTMPUT0",11,0) S DIR("A",1)=" Select one of the following:" "RTN","SDTMPUT0",12,0) S DIR("A",2)="" "RTN","SDTMPUT0",13,0) S DIR("A",3)=" C Clinic" "RTN","SDTMPUT0",14,0) S DIR("A",4)=" M Medical Center Division" "RTN","SDTMPUT0",15,0) S DIR("A",5)=" I Institution" "RTN","SDTMPUT0",16,0) S DIR("A",6)=" P Patient Information" "RTN","SDTMPUT0",17,0) S DIR("A",7)=" L List Telehealth Stop Codes" "RTN","SDTMPUT0",18,0) S DIR("A",8)=" S Telehealth Stop Code Lookup" "RTN","SDTMPUT0",19,0) S DIR("A",9)="" "RTN","SDTMPUT0",20,0) S DIR("A")="Search Option or (Q)uit: " "RTN","SDTMPUT0",21,0) D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DIRUT) G END "RTN","SDTMPUT0",22,0) S OPT=Y W ! "RTN","SDTMPUT0",23,0) D @OPT "RTN","SDTMPUT0",24,0) G EN "RTN","SDTMPUT0",25,0) ; "RTN","SDTMPUT0",26,0) C ; Search by clinic "RTN","SDTMPUT0",27,0) K DIC,SDCL,SDNO,NOD0,DIV,SDSL,MCD,INST,INSF,LTZ,CTRY,TZEX "RTN","SDTMPUT0",28,0) S DIC="^SC(",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))" "RTN","SDTMPUT0",29,0) S DIC("A")="Select CLINIC: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X I +Y'>0 G:+Y<0 C "RTN","SDTMPUT0",30,0) S SDCL=Y "RTN","SDTMPUT0",31,0) S SDNO="",NODE0=$G(^SC(+SDCL,0)),DIV=$P(NODE0,U,15) "RTN","SDTMPUT0",32,0) S SDSL=$G(^SC(+SDCL,"SL")),MCD=$G(^DG(40.8,DIV,0)),INST=$P(MCD,U,7) "RTN","SDTMPUT0",33,0) S INSF=$G(^DIC(4,INST,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3) "RTN","SDTMPUT0",34,0) W !!,SDASH,! "RTN","SDTMPUT0",35,0) W !,"Clinic",?18,": ",$TR(SDCL,"^","-") "RTN","SDTMPUT0",36,0) W !,"Medical Division",?18,": ",DIV,"-",$$GET1^DIQ(40.8,DIV,.01) "RTN","SDTMPUT0",37,0) W !,"Institution",?18,": ",INST,"-",$$GET1^DIQ(4,INST,.01) "RTN","SDTMPUT0",38,0) W !,"Station Number",?18,": ",$$GET1^DIQ(4,INST_",",99,"E") "RTN","SDTMPUT0",39,0) W !,"Stop Code",?18,": ",$P(NODE0,U,7),"-",$$GET1^DIQ(40.7,$P(NODE0,U,7),.01)," (",$$GET1^DIQ(40.7,$P(NODE0,U,7),1),")" "RTN","SDTMPUT0",40,0) W !,"Credit Stop Code",?18,": ",$P(NODE0,U,18),"-",$$GET1^DIQ(40.7,$P(NODE0,U,18),.01)," (",$$GET1^DIQ(40.7,$P(NODE0,U,18),1),")" "RTN","SDTMPUT0",41,0) W !,"Country",?18,": ",CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01) "RTN","SDTMPUT0",42,0) W !,"Location Timezone",?18,": ",LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01) "RTN","SDTMPUT0",43,0) W !,"Timezone Exception",?18,": ",TZEX "RTN","SDTMPUT0",44,0) W !,"Overbooks per day",?18,": ",$P(SDSL,U,7) "RTN","SDTMPUT0",45,0) D ACT "RTN","SDTMPUT0",46,0) W !,SDASH,!! G C "RTN","SDTMPUT0",47,0) Q "RTN","SDTMPUT0",48,0) ; "RTN","SDTMPUT0",49,0) M ; Search by Medical Center Division "RTN","SDTMPUT0",50,0) K DIC,ZD,MCD,INST,INSF,LTZ,CTRY,TZEX "RTN","SDTMPUT0",51,0) S DIC="^DG(40.8,",DIC(0)="AEMQ" D ^DIC K DIC "RTN","SDTMPUT0",52,0) Q:"^"[X I +Y'>0 W !,$C(7),"Division not found. Please try again." G M "RTN","SDTMPUT0",53,0) S ZD=+Y "RTN","SDTMPUT0",54,0) S MCD=$G(^DG(40.8,ZD,0)),INST=$P(MCD,U,7) "RTN","SDTMPUT0",55,0) S INSF=$G(^DIC(4,INST,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3) "RTN","SDTMPUT0",56,0) W !!,SDASH,! "RTN","SDTMPUT0",57,0) W !,"Medical Division",?18,": ",ZD,"-",$$GET1^DIQ(40.8,ZD,.01) "RTN","SDTMPUT0",58,0) W !,"Facility Number",?18,": ",$P(MCD,U,2) "RTN","SDTMPUT0",59,0) W !,"Institution",?18,": ",INST,"-",$$GET1^DIQ(4,INST,.01) "RTN","SDTMPUT0",60,0) W !,SDASH,!! G M "RTN","SDTMPUT0",61,0) Q "RTN","SDTMPUT0",62,0) ; "RTN","SDTMPUT0",63,0) I ; search by Institution "RTN","SDTMPUT0",64,0) K DIC,FAC,NOD0,NODE1,NODE8,II,ARR,LTZ,CTRY,TZEX,NODE99 "RTN","SDTMPUT0",65,0) S DIC="^DIC(4,",DIC(0)="AEMNQ" D ^DIC K DIC Q:Y<1 0 "RTN","SDTMPUT0",66,0) Q:"^"[X I +Y'>0 W !,$C(7),"Institution not found. Please try again." G I "RTN","SDTMPUT0",67,0) S FAC=Y "RTN","SDTMPUT0",68,0) S NODE0=$G(^DIC(4,+Y,0)),NODE1=$G(^DIC(4,+Y,1)) "RTN","SDTMPUT0",69,0) S NODE8=$G(^DIC(4,+Y,8)),LTZ=$P(NODE8,U),CTRY=$P(NODE8,U,2),TZEX=$P(NODE8,U,3) "RTN","SDTMPUT0",70,0) S NODE99=$G(^DIC(4,+Y,99)) "RTN","SDTMPUT0",71,0) W !!,SDASH,! "RTN","SDTMPUT0",72,0) W !,"Name",?18,": ",$TR(FAC,"^","-") "RTN","SDTMPUT0",73,0) W !,"City",?18,": ",$P(NODE1,U,3) "RTN","SDTMPUT0",74,0) W !,"State",?18,": ",$P(NODE0,U,2),"-",$$GET1^DIQ(5,$P(NODE0,U,2),.01) "RTN","SDTMPUT0",75,0) W !,"District",?18,": ",$P(NODE0,U,3) "RTN","SDTMPUT0",76,0) W !,"VA region IEN",?18,": ",$P(NODE0,U,7) "RTN","SDTMPUT0",77,0) W !,"Location Timezone",?18,": ",LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01) "RTN","SDTMPUT0",78,0) W !,"Timezone Exception",?18,": ",TZEX "RTN","SDTMPUT0",79,0) W !,"Country",?18,": ",CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01) "RTN","SDTMPUT0",80,0) W !,"Station #",?18,": ",$P(NODE99,U) "RTN","SDTMPUT0",81,0) W !,"Facility DEA #:",?18,": ",$P($G(^DIC(4,+FAC,"DEA")),U) "RTN","SDTMPUT0",82,0) W !,"Facility Exp. date:",?18,": ",$P($G(^DIC(4,+FAC,"DEA")),U,2) "RTN","SDTMPUT0",83,0) S II=0 F S II=$O(^DIC(4,+FAC,7,II)) Q:'II K ARR D GETS^DIQ(4.014,II_","_+FAC,".01;1","E","ARR") D "RTN","SDTMPUT0",84,0) . W !,"Association",?18,": ",II_"-"_ARR(4.014,II_","_+FAC_",",.01,"E") "RTN","SDTMPUT0",85,0) . W ?40," Parent",": ",II_"-"_ARR(4.014,II_","_+FAC_",",1,"E") "RTN","SDTMPUT0",86,0) W !,SDASH,!! G I "RTN","SDTMPUT0",87,0) Q "RTN","SDTMPUT0",88,0) ; "RTN","SDTMPUT0",89,0) P ; search by patient "RTN","SDTMPUT0",90,0) K DIC,DFN,MPI,XX,ICNHA,VADM "RTN","SDTMPUT0",91,0) S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select Patient: " D ^DIC K DIC "RTN","SDTMPUT0",92,0) Q:"^"[X I +Y'>0 W !,$C(7),"Patient not found. Please try again." G P "RTN","SDTMPUT0",93,0) S DFN=+Y D 2^VADPT S MPI=$G(^DPT(DFN,"MPI")) "RTN","SDTMPUT0",94,0) W !!,SDASH,! "RTN","SDTMPUT0",95,0) W !,"Number (IEN)",?18,": ",DFN "RTN","SDTMPUT0",96,0) W !,"Name",?18,": ",VADM(1) "RTN","SDTMPUT0",97,0) W !,"Sex",?18,": ",$P(VADM(5),U,2) "RTN","SDTMPUT0",98,0) W !,"Date of Birth",?18,": ",$P(VADM(3),U,2) "RTN","SDTMPUT0",99,0) W !,"SSN",?18,": ",$P(VADM(2),U,2) "RTN","SDTMPUT0",100,0) W !,"Full ICN",?18,": ",$P(MPI,U,10) "RTN","SDTMPUT0",101,0) W !,"Integrated Control: ",$P(MPI,U) "RTN","SDTMPUT0",102,0) W !,"ICN Checksum",?18,": ",$P(MPI,U,2) "RTN","SDTMPUT0",103,0) D ICN W !,"Full ICN History :" S XX=0 F S XX=$O(ICNHA(XX)) Q:'XX W ?20,$G(ICNHA(XX)),! "RTN","SDTMPUT0",104,0) W !,"Deceased Date",?18,": ",$P($P(VADM(6),U,2),"@") "RTN","SDTMPUT0",105,0) W !,SDASH,!! G P "RTN","SDTMPUT0",106,0) Q "RTN","SDTMPUT0",107,0) ; "RTN","SDTMPUT0",108,0) S ; Telehealth stop code "RTN","SDTMPUT0",109,0) K DIC,CODE,STP1,STP2,F407,S407 "RTN","SDTMPUT0",110,0) S DIC="^SD(40.6,",DIC(0)="AEMNQ" D ^DIC K DIC "RTN","SDTMPUT0",111,0) Q:"^"[X I +Y'>0 W !,$C(7),"Telehealth Stop Code not found. Please try again." G S "RTN","SDTMPUT0",112,0) S CODE=$P(Y,U,2),STP1=$E(CODE,1,3),STP2=$E(CODE,4,6) "RTN","SDTMPUT0",113,0) S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0)) "RTN","SDTMPUT0",114,0) W !!,SDASH,! "RTN","SDTMPUT0",115,0) W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",116,0) I $G(STP2) W !,"Stop Code: ",STP2," > ",$P($G(^DIC(40.7,S407,0)),U) "RTN","SDTMPUT0",117,0) W !,SDASH,!! K X,Y G S "RTN","SDTMPUT0",118,0) Q "RTN","SDTMPUT0",119,0) ; "RTN","SDTMPUT0",120,0) L ; list Telehealth stop codes "RTN","SDTMPUT0",121,0) K DIC,CNT,II,STP1,STP2,F407,S407 "RTN","SDTMPUT0",122,0) S CNT=0 W !!,SDASH,! "RTN","SDTMPUT0",123,0) S II=0 F S II=$O(^SD(40.6,"B",II)) Q:'II D "RTN","SDTMPUT0",124,0) . S CNT=CNT+1,STP1=$E(II,1,3),STP2=$E(II,4,6) "RTN","SDTMPUT0",125,0) . S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0)) "RTN","SDTMPUT0",126,0) . I STP2 W !,"Stop Code: ",STP1_STP2 D Q "RTN","SDTMPUT0",127,0) . . W !,?11,STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",128,0) . . W !,?11,STP2," > ",$P($G(^DIC(40.7,S407,0)),U) "RTN","SDTMPUT0",129,0) . W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",130,0) W !,SDASH "RTN","SDTMPUT0",131,0) W !,"Total number of Telehealth Stop code: ",CNT,!! "RTN","SDTMPUT0",132,0) S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT0",133,0) Q "RTN","SDTMPUT0",134,0) ; "RTN","SDTMPUT0",135,0) ICN ; full ICN history "RTN","SDTMPUT0",136,0) K ICNHA "RTN","SDTMPUT0",137,0) I '$D(^DPT(DFN,"MPIFICNHIS")) S ICNHA(1)="NO ICN HISTORY" Q "RTN","SDTMPUT0",138,0) S (SIEN,CNT)=0 "RTN","SDTMPUT0",139,0) F S SIEN=$O(^DPT(DFN,"MPIFICNHIS",SIEN)) Q:'SIEN D "RTN","SDTMPUT0",140,0) . S FICN=$P($G(^DPT(DFN,"MPIFICNHIS",SIEN,0)),"^") I FICN'="" S CNT=CNT+1,ICNHA(CNT)=FICN "RTN","SDTMPUT0",141,0) I CNT=0 S ICNHA(1)="NO ICN HISTORY" Q "RTN","SDTMPUT0",142,0) S ICNHA=CNT "RTN","SDTMPUT0",143,0) Q "RTN","SDTMPUT0",144,0) ; "RTN","SDTMPUT0",145,0) ACT ; inactive clinic "RTN","SDTMPUT0",146,0) I $D(^SC(+SDCL,"I")) S SDRE=+$P(^("I"),U,2),SDIN=+^("I") I SDRE'=SDIN I SDIN'>DT&(SDRE=0!(SDRE>DT)) D "RTN","SDTMPUT0",147,0) . S Y=SDIN D DTS^SDUTL W !!,?4,"**** Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"")," ****" K SDIN,SDRE S SDNO=1 "RTN","SDTMPUT0",148,0) I 'SDNO,$D(SDIN),SDIN>DT,SDRE'=SDIN W !!,?4,"**** Clinic will be inactive ",$S(SDRE:"from ",1:"as of ") S Y=SDIN D DTS^SDUTL W Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"")," ****" K SDIN,SDRE "RTN","SDTMPUT0",149,0) Q "RTN","SDTMPUT0",150,0) ; "RTN","SDTMPUT0",151,0) END K ARR,CNT,CODE,CTRY,DFN,FAC,F407,S407,ICNHA,SIEN,II,MPI,NODE1,NODE8,NODE99,FICN,SDCL,NODE0,DIV,MCD,INST,INSF "RTN","SDTMPUT0",152,0) K LTZ,SDASH,STP1,STP2,TZEX,SDSL,SDRE,SDIN,SDNO,OPT,VADM,XX,ZD "RTN","SDTMPUT0",153,0) Q "RTN","SDTMPUT1") 0^9^B16907997^n/a "RTN","SDTMPUT1",1,0) SDTMPUT1 ;MS/SJA - VISTA-TELEHEALTH UPDATE UTILITY ;Dec 17, 2020 "RTN","SDTMPUT1",2,0) ;;5.3;Scheduling;**773**;Aug 13, 1993;Build 9 "RTN","SDTMPUT1",3,0) ; "RTN","SDTMPUT1",4,0) ; "RTN","SDTMPUT1",5,0) N ACT,ALL,CLN,DIV,III,SDALL,SDASH,SDEF,SDOUT,SDLT,SDV1,STIEN,XX,SEL,TOT,VAUTD "RTN","SDTMPUT1",6,0) EN ; "RTN","SDTMPUT1",7,0) S $P(SDASH,"=",80)="",(SEL,ACT,DIV)="",(ALL,SDOUT)=0 "RTN","SDTMPUT1",8,0) W @IOF W !,?22,"VistA Real-Time Clinic Updates",! "RTN","SDTMPUT1",9,0) D ASK Q:SDOUT "RTN","SDTMPUT1",10,0) S:$G(VAUTD)=1 DIV="ALL" "RTN","SDTMPUT1",11,0) W ! D @SEL "RTN","SDTMPUT1",12,0) G EN "RTN","SDTMPUT1",13,0) ; "RTN","SDTMPUT1",14,0) C ; clinic "RTN","SDTMPUT1",15,0) K ^TMP($J) "RTN","SDTMPUT1",16,0) K DIC,DTOUT,DUOUT S DIC="^SC(",DIC(0)="AEQM",DIC("A")="Select Clinic: " "RTN","SDTMPUT1",17,0) 1 D ^DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Another one:" G 1 "RTN","SDTMPUT1",18,0) I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q "RTN","SDTMPUT1",19,0) W !!,SDASH,! "RTN","SDTMPUT1",20,0) F III=0:0 S III=$O(^TMP($J,III)) Q:'III W !,"Clinic: ",III,?15,$$GET1^DIQ(44,III,.01) "RTN","SDTMPUT1",21,0) W !,SDASH,! "RTN","SDTMPUT1",22,0) F III=0:0 S III=$O(^TMP($J,III)) Q:'III D "RTN","SDTMPUT1",23,0) . D EN^SDTMPHLB(III) W !,"Sending HL7 message for Clinic: ",$$GET1^DIQ(44,III,.01) "RTN","SDTMPUT1",24,0) W !! S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT1",25,0) Q "RTN","SDTMPUT1",26,0) ; "RTN","SDTMPUT1",27,0) S ; stop codes "RTN","SDTMPUT1",28,0) K ^TMP($J),^TMP($J,"CLN") S (TOT,TOT(0),TOT(1))=0 "RTN","SDTMPUT1",29,0) K DIC,DTOUT,DUOUT S DIC="^SD(40.6,",DIC(0)="AEMQ",DIC("A")="Select Telehealth Stop Code: " "RTN","SDTMPUT1",30,0) 2 D ^DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Select another Telehealth Stop Code: " G 2 "RTN","SDTMPUT1",31,0) I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q "RTN","SDTMPUT1",32,0) W !!,SDASH,! "RTN","SDTMPUT1",33,0) F STIEN=0:0 S STIEN=$O(^TMP($J,STIEN)) Q:'STIEN S CLN=$$ST(STIEN,DIV) "RTN","SDTMPUT1",34,0) F III=0:0 S III=$O(^TMP($J,"CLN",III)) Q:'III D "RTN","SDTMPUT1",35,0) . W:TOT=0 !,SDASH,! "RTN","SDTMPUT1",36,0) . D EN^SDTMPHLB(III) W !,"Sending HL7 message for Clinic: ",III,"-",$$GET1^DIQ(44,III,.01) S TOT=TOT+1 "RTN","SDTMPUT1",37,0) W !! "RTN","SDTMPUT1",38,0) I ACT="B" D "RTN","SDTMPUT1",39,0) . W !,"Total number of Active clinics updated: ",TOT(1) "RTN","SDTMPUT1",40,0) . W !,"Total number of Inactive clinics updated: ",TOT(0) "RTN","SDTMPUT1",41,0) W !,"Total number of clinics updated: ",TOT "RTN","SDTMPUT1",42,0) W !! S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT1",43,0) Q "RTN","SDTMPUT1",44,0) ST(STIEN,DIV) ; "RTN","SDTMPUT1",45,0) N FLG1,FLG2,CODE,STP1,STP2,F407,S407,II,NODE0,STOP1,STOP2,XX "RTN","SDTMPUT1",46,0) S (F407,S407,STP1,STP2)=0 "RTN","SDTMPUT1",47,0) S CODE=$G(^SD(40.6,STIEN,0)),STP1=$E(CODE,1,3),STP2=$E(CODE,4,6) "RTN","SDTMPUT1",48,0) S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0)) "RTN","SDTMPUT1",49,0) S II=0 "RTN","SDTMPUT1",50,0) F S II=$O(^SC(II)) Q:'II S (FLG1,FLG2)=0 D "RTN","SDTMPUT1",51,0) . S NODE0=$G(^SC(II,0)) I DIV'="ALL" Q:'$$DIVCHK($P(NODE0,U,15)) "RTN","SDTMPUT1",52,0) . S STOP1=$P(NODE0,"^",7),STOP2=$P(NODE0,"^",18) "RTN","SDTMPUT1",53,0) . Q:($G(STOP1)="")&(($G(STOP2))="") "RTN","SDTMPUT1",54,0) . I $G(F407)!$G(S407) D "RTN","SDTMPUT1",55,0) . . I (F407=STOP1)!(S407=STOP1) S FLG1=1 "RTN","SDTMPUT1",56,0) . . I (F407=STOP2)!(S407=STOP2) S FLG2=1 "RTN","SDTMPUT1",57,0) . I 'FLG1,'FLG2 Q "RTN","SDTMPUT1",58,0) . S XX=$$ACTIVE(II) I ACT="B" S TOT(XX)=TOT(XX)+1 "RTN","SDTMPUT1",59,0) . I (XX&(ACT="I"))!('XX&(ACT="A")) Q "RTN","SDTMPUT1",60,0) . W !,"Clinic: ",II W:ACT="B" ?15,$S(XX:"'A'",'XX:"'I'",1:"") W ?20,"(",$S(STOP1:$$GET1^DIQ(40.7,STOP1,1),1:" "),"/",$S(STOP2:$$GET1^DIQ(40.7,STOP2,1),1:" "),") ",$P(NODE0,U) D "RTN","SDTMPUT1",61,0) . . S ^TMP($J,"CLN",II)="" "RTN","SDTMPUT1",62,0) Q 1 "RTN","SDTMPUT1",63,0) ; "RTN","SDTMPUT1",64,0) EXIT ; "RTN","SDTMPUT1",65,0) K DTOUT,DUOUT,DTOT "RTN","SDTMPUT1",66,0) K ^TMP($J) "RTN","SDTMPUT1",67,0) Q "RTN","SDTMPUT1",68,0) ; "RTN","SDTMPUT1",69,0) ASK W ! K DIR,Y S DIR(0)="SA^C:Clinic;S:Stop Code;Q:Quit" "RTN","SDTMPUT1",70,0) S DIR("A")="Select (C)linic, (S)top Code or (Q)uit: " "RTN","SDTMPUT1",71,0) S DIR("B")="C" "RTN","SDTMPUT1",72,0) D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DUOUT) S SDOUT=1 Q "RTN","SDTMPUT1",73,0) S SEL=Y W ! I SEL="C" Q "RTN","SDTMPUT1",74,0) ; "RTN","SDTMPUT1",75,0) S DIR(0)="SA^A:Active;I:Inactive;B:Both" "RTN","SDTMPUT1",76,0) S DIR("A")="(A)ctive Clinics, (I)nactive Clinics, (B)oth: " "RTN","SDTMPUT1",77,0) S DIR("?",1)="Enter an 'A' for Active Clinics, 'I' for Inactive Clinics," "RTN","SDTMPUT1",78,0) S DIR("?")="'B' for Both Active and Inactive Clinics" "RTN","SDTMPUT1",79,0) S DIR("B")="A" "RTN","SDTMPUT1",80,0) D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q "RTN","SDTMPUT1",81,0) S ACT=Y W ! "RTN","SDTMPUT1",82,0) ; "RTN","SDTMPUT1",83,0) DIV ; ask for division "RTN","SDTMPUT1",84,0) D ASK2^SDDIV S:Y<0 SDOUT=1 "RTN","SDTMPUT1",85,0) Q "RTN","SDTMPUT1",86,0) ; "RTN","SDTMPUT1",87,0) DIVCHK(CLNDIV) ; check clinic division "RTN","SDTMPUT1",88,0) N FLG,FF "RTN","SDTMPUT1",89,0) S FLG=0 "RTN","SDTMPUT1",90,0) I $G(VAUTD)=0 S FF=0 F S FF=$O(VAUTD(FF)) Q:'FF I CLNDIV=FF S FLG=1 Q "RTN","SDTMPUT1",91,0) Q FLG "RTN","SDTMPUT1",92,0) ; "RTN","SDTMPUT1",93,0) ACTIVE(LOC) ;determine if clinic is active "RTN","SDTMPUT1",94,0) ; Output X:1=ACTIVE, "RTN","SDTMPUT1",95,0) ; X:0=INACTIVE "RTN","SDTMPUT1",96,0) N NODE,I1,I2,X "RTN","SDTMPUT1",97,0) S X=0 "RTN","SDTMPUT1",98,0) S NODE=$G(^SC(LOC,"I")) Q:NODE="" 1 "RTN","SDTMPUT1",99,0) S I1=$P(NODE,U,1) ;inactive date/time "RTN","SDTMPUT1",100,0) S I2=$P(NODE,U,2) ;reactive date/time "RTN","SDTMPUT1",101,0) I (I1="") S X=1 Q X "RTN","SDTMPUT1",102,0) I ((I1'="")&(I1>DT))!((I2'="")&(I2'>DT)) S X=1 Q X "RTN","SDTMPUT1",103,0) Q X "RTN","SDTMPUT1",104,0) ; "VER") 8.0^22.2 "BLD",11625,6) ^636 **END** **END**