EMERGENCY Released SD*5.3*754 SEQ #613 Extracted from mail message **KIDS**:SD*5.3*754^ **INSTALL NAME** SD*5.3*754 "BLD",11688,0) SD*5.3*754^SCHEDULING^0^3200722^y "BLD",11688,1,0) ^^2^2^3200713^^^^ "BLD",11688,1,1,0) The description of this build can be found in the National Patch Module "BLD",11688,1,2,0) under SD*5.3*754. "BLD",11688,4,0) ^9.64PA^^ "BLD",11688,6.3) 5 "BLD",11688,"ABPKG") n "BLD",11688,"INID") ^n "BLD",11688,"INIT") EN^SD53P754 "BLD",11688,"KRN",0) ^9.67PA^1.5^25 "BLD",11688,"KRN",.4,0) .4 "BLD",11688,"KRN",.401,0) .401 "BLD",11688,"KRN",.402,0) .402 "BLD",11688,"KRN",.403,0) .403 "BLD",11688,"KRN",.5,0) .5 "BLD",11688,"KRN",.84,0) .84 "BLD",11688,"KRN",1.5,0) 1.5 "BLD",11688,"KRN",1.6,0) 1.6 "BLD",11688,"KRN",1.61,0) 1.61 "BLD",11688,"KRN",1.62,0) 1.62 "BLD",11688,"KRN",3.6,0) 3.6 "BLD",11688,"KRN",3.8,0) 3.8 "BLD",11688,"KRN",9.2,0) 9.2 "BLD",11688,"KRN",9.2,"NM",0) ^9.68A^^ "BLD",11688,"KRN",9.8,0) 9.8 "BLD",11688,"KRN",9.8,"NM",0) ^9.68A^2^1 "BLD",11688,"KRN",9.8,"NM",2,0) SDHL7APT^^0^B272423848 "BLD",11688,"KRN",9.8,"NM","B","SDHL7APT",2) "BLD",11688,"KRN",19,0) 19 "BLD",11688,"KRN",19.1,0) 19.1 "BLD",11688,"KRN",101,0) 101 "BLD",11688,"KRN",409.61,0) 409.61 "BLD",11688,"KRN",771,0) 771 "BLD",11688,"KRN",779.2,0) 779.2 "BLD",11688,"KRN",870,0) 870 "BLD",11688,"KRN",8989.51,0) 8989.51 "BLD",11688,"KRN",8989.52,0) 8989.52 "BLD",11688,"KRN",8993,0) 8993 "BLD",11688,"KRN",8994,0) 8994 "BLD",11688,"KRN","B",.4,.4) "BLD",11688,"KRN","B",.401,.401) "BLD",11688,"KRN","B",.402,.402) "BLD",11688,"KRN","B",.403,.403) "BLD",11688,"KRN","B",.5,.5) "BLD",11688,"KRN","B",.84,.84) "BLD",11688,"KRN","B",1.5,1.5) "BLD",11688,"KRN","B",1.6,1.6) "BLD",11688,"KRN","B",1.61,1.61) "BLD",11688,"KRN","B",1.62,1.62) "BLD",11688,"KRN","B",3.6,3.6) "BLD",11688,"KRN","B",3.8,3.8) "BLD",11688,"KRN","B",9.2,9.2) "BLD",11688,"KRN","B",9.8,9.8) "BLD",11688,"KRN","B",19,19) "BLD",11688,"KRN","B",19.1,19.1) "BLD",11688,"KRN","B",101,101) "BLD",11688,"KRN","B",409.61,409.61) "BLD",11688,"KRN","B",771,771) "BLD",11688,"KRN","B",779.2,779.2) "BLD",11688,"KRN","B",870,870) "BLD",11688,"KRN","B",8989.51,8989.51) "BLD",11688,"KRN","B",8989.52,8989.52) "BLD",11688,"KRN","B",8993,8993) "BLD",11688,"KRN","B",8994,8994) "BLD",11688,"QUES",0) ^9.62^^ "BLD",11688,"REQB",0) ^9.611^1^1 "BLD",11688,"REQB",1,0) SD*5.3*714^1 "BLD",11688,"REQB","B","SD*5.3*714",1) "INIT") EN^SD53P754 "MBREQ") 0 "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813^2930930 "PKG",16,22,1,"PAH",1,0) 754^3200722 "PKG",16,22,1,"PAH",1,1,0) ^^2^2^3200722 "PKG",16,22,1,"PAH",1,1,1,0) The description of this build can be found in the National Patch Module "PKG",16,22,1,"PAH",1,1,2,0) under SD*5.3*754. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","SD53P754") 0^^B31568316^n/a "RTN","SD53P754",1,0) SD53P754 ;MS/GN - TMP POST INSTALL;July 05, 2018 "RTN","SD53P754",2,0) ;;5.3;Scheduling;**754**;May 29, 2018;Build 5 "RTN","SD53P754",3,0) ; "RTN","SD53P754",4,0) ;Post install routine for SD*5.3*754 to cleanup file 409.85 and add a CID date that was null. "RTN","SD53P754",5,0) ;This routine will be left installed for possible UNDO tag execution during a backout patch scenario. "RTN","SD53P754",6,0) ; ** Note: UNDO will not work if XTMP has been purged after its 90 day expiration date. ** "RTN","SD53P754",7,0) ; Site can delete this routine anytime they prefer at a later date. "RTN","SD53P754",8,0) ; "RTN","SD53P754",9,0) EN ;Begin Post Install "RTN","SD53P754",10,0) S BEGDT=$P(^XPD(9.7,$O(^XPD(9.7,"B","SD*5.3*704","")),0),U,3)\1 "RTN","SD53P754",11,0) S ENDDT=$P(^XPD(9.7,$O(^XPD(9.7,"B","SD*5.3*714","")),0),U,3)\1 "RTN","SD53P754",12,0) D FIXCID(BEGDT,ENDDT) ;strt date of search for bad data AFTER *704, end date of search after *714 "RTN","SD53P754",13,0) Q "RTN","SD53P754",14,0) FIXCID(BEGIN,END) ;Fix CID/PREFERRED DATE OF APPT field (#22) in SDEC APPOINTMENT REQUEST file (#409.85) "RTN","SD53P754",15,0) N AP,APSTS,CDT,CNT,CNTD,ERRCNT,ERRDIS S (CNT,CNTD,ERRCNT,ERRDIS)=0 "RTN","SD53P754",16,0) S NAME="SD53P754" "RTN","SD53P754",17,0) S ^XTMP(NAME,0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"POST INSTALL SD53P754 TMP APPT CID DT FIX" "RTN","SD53P754",18,0) D MES^XPDUTL("") "RTN","SD53P754",19,0) D MES^XPDUTL("Beginning update of data in the SDEC APPT REQUEST file...") "RTN","SD53P754",20,0) D MES^XPDUTL("") "RTN","SD53P754",21,0) ; "RTN","SD53P754",22,0) ;Save original 0 & "DIS" nodes prior to updating date fields to XTMP for 60 days, after 60 it will be auto deleted. "RTN","SD53P754",23,0) ; "RTN","SD53P754",24,0) ;Update recs with null CID/Preferred Date of Appt field #22 in the SDEC APPT REQUEST file (#409.85) "RTN","SD53P754",25,0) S (CNT,CNTO)=0 "RTN","SD53P754",26,0) F ST="C","O" D "RTN","SD53P754",27,0) . F DTE=BEGIN:0 S DTE=$O(^SDEC(409.85,"E",ST,DTE)) Q:('DTE)!(DTE>END) D "RTN","SD53P754",28,0) .. F AP=0:0 S AP=$O(^SDEC(409.85,"E",ST,DTE,AP)) Q:'AP D:'$P(^SDEC(409.85,AP,0),U,16) "RTN","SD53P754",29,0) ... S:ST="C" CNT=CNT+1 S:ST="O" CNTO=CNTO+1 "RTN","SD53P754",30,0) ... S APNODE0=^SDEC(409.85,AP,0),^XTMP(NAME,AP,"BEFOR")=APNODE0 "RTN","SD53P754",31,0) ... S APSTS=$P(APNODE0,U,17) ;get appt sts "RTN","SD53P754",32,0) ... S CDT=+$P(APNODE0,U,2) S:'CDT CDT=DT ;get CREATE DATE FIELD (#1) for updating CID date, else DT "RTN","SD53P754",33,0) ... D UPDCID(AP,CDT) ;update CID field "RTN","SD53P754",34,0) ... I '$P($G(^SDEC(409.85,AP,"DIS")),U) D "RTN","SD53P754",35,0) .... S ^XTMP(NAME,AP,"DIS BEFOR")=$G(^SDEC(409.85,AP,"DIS")) "RTN","SD53P754",36,0) .... D UPDDIS(AP,CDT,APSTS) ;Update DIS nodes "RTN","SD53P754",37,0) D MES^XPDUTL(""),MES^XPDUTL("==== Appt Records Fixed ====") "RTN","SD53P754",38,0) D MES^XPDUTL(""),MES^XPDUTL(" Open sts Count: "_CNTO) "RTN","SD53P754",39,0) D MES^XPDUTL(""),MES^XPDUTL("Closed sts Count: "_CNT) "RTN","SD53P754",40,0) D MES^XPDUTL(""),MES^XPDUTL(" Total Count: "_(CNT+CNTO)) "RTN","SD53P754",41,0) S ^XTMP(NAME,0,"TOTAL EMPTY CID RECORDS UPDATED")=CNT "RTN","SD53P754",42,0) S ^XTMP(NAME,0,"TOTAL EMPTY CID UPDATE ERRORS")=ERRCNT "RTN","SD53P754",43,0) S ^XTMP(NAME,0,"TOTAL EMPTY DIS RECORDS UPDATED")=CNTD "RTN","SD53P754",44,0) S ^XTMP(NAME,0,"TOTAL EMPTY DIS UPDATE ERRORS")=ERRDIS "RTN","SD53P754",45,0) S ^XTMP(NAME,0,"TOTAL FILE ERRORS")=(ERRCNT+ERRDIS) "RTN","SD53P754",46,0) D MES^XPDUTL("") "RTN","SD53P754",47,0) D MES^XPDUTL("===== Update Completed =====") "RTN","SD53P754",48,0) D MES^XPDUTL("") "RTN","SD53P754",49,0) Q "RTN","SD53P754",50,0) UPDCID(AP,CDT) ;Update 409.85 file field #22 "RTN","SD53P754",51,0) ; AP - Rec ien for 409.85 file "RTN","SD53P754",52,0) ; CDT - CID date (FM format no time) in Appt Req file "RTN","SD53P754",53,0) N ERR,FDA "RTN","SD53P754",54,0) S FDA(409.85,AP_",",22)=CDT "RTN","SD53P754",55,0) D UPDATE^DIE(,"FDA","ERR") "RTN","SD53P754",56,0) S ^XTMP(NAME,AP,"AFTER")=^SDEC(409.85,AP,0) "RTN","SD53P754",57,0) I $D(ERR) D "RTN","SD53P754",58,0) . D MES^XPDUTL("FileMan error when updating APPT recnum: "_AP) S ERRCNT=ERRCNT+1 M ^XTMP(NAME,AP,"ERR")=ERR "RTN","SD53P754",59,0) E D "RTN","SD53P754",60,0) . S CNT=CNT+1 "RTN","SD53P754",61,0) Q "RTN","SD53P754",62,0) UPDDIS(AP,DDT,APSTS) ;Update the "DIS" node in 409.85 file field all fields especially date (#19) "RTN","SD53P754",63,0) ; AP - Rec ien for 409.85 file "RTN","SD53P754",64,0) ; CDT - Dispositioned date (FM format no time) in Appt Req file "RTN","SD53P754",65,0) ; "RTN","SD53P754",66,0) ;If DIS date is null then prodeed, else do nothing, update this node as follows: "RTN","SD53P754",67,0) ; "RTN","SD53P754",68,0) ; DIS;1 19 DATE DISPOSITIONED = same date used in CID update "RTN","SD53P754",69,0) ; DIS;2 20 DISPOSITIONED BY = DUZ "RTN","SD53P754",70,0) ; DIS;3 21 DISPOSITION = "SA" "RTN","SD53P754",71,0) ; DIS;4 21.1 DISPOSITION CLOSED BY CLEANUP = <-- ???? LEAVE NULL FOR NOW ???? "RTN","SD53P754",72,0) ; DESCRIPTION: Enter Yes if Disposition is related to Open Request "RTN","SD53P754",73,0) ; becoming Closed due to the running of Cleanup Utility. "RTN","SD53P754",74,0) ; Otherwise enter No. "RTN","SD53P754",75,0) N ERR,FDA "RTN","SD53P754",76,0) D:'$P($G(^SDEC(409.85,AP,"DIS")),U) ;If no 1st piece (date), then update this DIS node with all data "RTN","SD53P754",77,0) . S FDA(409.85,AP_",",19)=$P(DDT,".") "RTN","SD53P754",78,0) . S FDA(409.85,AP_",",20)=DUZ "RTN","SD53P754",79,0) . S FDA(409.85,AP_",",21)="SA" "RTN","SD53P754",80,0) . D UPDATE^DIE(,"FDA","ERR") "RTN","SD53P754",81,0) . M ^XTMP(NAME,AP,"DIS AFTER")=^SDEC(409.85,AP,"DIS") "RTN","SD53P754",82,0) I $D(ERR) D "RTN","SD53P754",83,0) . D MES^XPDUTL("FileMan error when updating DIS recnum: "_AP) S ERRDIS=ERRDIS+1 M ^XTMP(NAME,AP,"ERR DIS")=ERR "RTN","SD53P754",84,0) E D "RTN","SD53P754",85,0) . S CNTD=CNTD+1 "RTN","SD53P754",86,0) Q "RTN","SD53P754",87,0) DISP ;QUICK DISPLAY OF SDEC RECS TOUCHED IF CURIOUS? "RTN","SD53P754",88,0) ; assumes Refletion display settings set to max of 999 memory to see all or, "RTN","SD53P754",89,0) ; user will turn on logging to record to a flat file or, "RTN","SD53P754",90,0) ; user will use %G to access XTMP directly "RTN","SD53P754",91,0) N PG,LN S (PG,LN)=0 W # W # "RTN","SD53P754",92,0) W !!!,"APPROXIMATE NUMBER OF SCREEN PAGES TO DISPLAY... ",^XTMP("SD53P754",0,"TOTAL EMPTY CID RECORDS UPDATED")\7 H 3 W # "RTN","SD53P754",93,0) F AP=0:0 S AP=$O(^XTMP("SD53P754",AP)) Q:'AP D "RTN","SD53P754",94,0) . D:LN#7=0 HDR S LN=LN+1 "RTN","SD53P754",95,0) . W !,"0: ",AP,?14,$P(^SDEC(409.85,AP,0),U,1,17) "RTN","SD53P754",96,0) . W !,"DIS:",?15,$G(^SDEC(409.85,AP,"DIS")),! "RTN","SD53P754",97,0) W #!,?20,"Ctrl + PgUp for previous page.",!,?17,"(hold down both for continuous scrolling)",! "RTN","SD53P754",98,0) W !?3,"Assumes Reflection Display Settings = 999 Memory blocks to retain all pages" "RTN","SD53P754",99,0) Q "RTN","SD53P754",100,0) HDR ;Write screen header "RTN","SD53P754",101,0) U 0 "RTN","SD53P754",102,0) S PG=PG+1 "RTN","SD53P754",103,0) W # "RTN","SD53P754",104,0) W "Node 0: IEN ^ Create dte",?36,"",?53,"^16 CID dte ^17 Open/Close",! "RTN","SD53P754",105,0) W "DIS node: date ^ duz ^ sts" "RTN","SD53P754",106,0) W !,"================================================================================" "RTN","SD53P754",107,0) Q "RTN","SD53P754",108,0) CNT ;pre-post install null CID datre count entire 409.85 file "RTN","SD53P754",109,0) S CNT=0,CNTERR=0 "RTN","SD53P754",110,0) F AP=0:0 S AP=$O(^SDEC(409.85,AP)) Q:'AP S CNT=CNT+1 I '$P(^SDEC(409.85,AP,0),U,2),'$P(^SDEC(409.85,AP,0),U,17) S CNTERR=CNTERR+1 "RTN","SD53P754",111,0) W !,"cid null count: ",?40,$J(CNT,10),!,"date entered is also null count: ",?40,$J(CNTERR,10),!,"difference: ",?40,$J((CNT-CNTERR),10) "RTN","SD53P754",112,0) Q "RTN","SD53P754",113,0) ALL ;ALL RECD COUNTED INEGRITY OF "E" XREF VS $O OF 0 NODES "RTN","SD53P754",114,0) N ST,DTE,AP,CNT,ECNT,NCNT,DCNT,XCNT,XEC "RTN","SD53P754",115,0) S (CNT,ECNT,NCNT,DCNT,XCNT,XEC)=0 "RTN","SD53P754",116,0) W !,"Analyzing." "RTN","SD53P754",117,0) F AP=0:0 S AP=$O(^SDEC(409.85,AP)) Q:'AP D "RTN","SD53P754",118,0) . S APNODE0=^SDEC(409.85,AP,0) "RTN","SD53P754",119,0) . S CNT=CNT+1 W:CNT#6000=0 "." "RTN","SD53P754",120,0) . S:'$P(APNODE0,U,16) ECNT=ECNT+1 "RTN","SD53P754",121,0) . S:$P(APNODE0,U,17)="" NCNT=NCNT+1 "RTN","SD53P754",122,0) . I '$P(APNODE0,U,2) W !,AP,?20,APNODE0 S DCNT=DCNT+1 "RTN","SD53P754",123,0) F ST="C","O" F DTE=0:0 S DTE=$O(^SDEC(409.85,"E",ST,DTE)) Q:'DTE D "RTN","SD53P754",124,0) . F AP=0:0 S AP=$O(^SDEC(409.85,"E",ST,DTE,AP)) Q:'AP S XCNT=XCNT+1 S:'$P(^SDEC(409.85,AP,0),U,16) XEC=XEC+1 "RTN","SD53P754",125,0) W !!,"TOTL ",CNT,!,"NCID ",ECNT,!,"NOST ",NCNT,!,"NODT ",DCNT,!!,"XREF ",XCNT,!,"XFIX ",XEC,!! "RTN","SD53P754",126,0) Q "RTN","SD53P754",127,0) UNDO ;UNDO MY CURRENT UPDATE FOR CID & DIS "RTN","SD53P754",128,0) N AP,ERR,FDA "RTN","SD53P754",129,0) F AP=0:0 S AP=$O(^XTMP("SD53P754",AP)) Q:'AP D "RTN","SD53P754",130,0) . W !,AP "RTN","SD53P754",131,0) . ;update the CID/PREFERRED DATE OF APPT date field (#22) in the SDEC APPT REQUEST file (#409.85) "RTN","SD53P754",132,0) . Q:'$D(^XTMP("SD53P754",AP,"AFTER")) "RTN","SD53P754",133,0) . W !,AP,"<<<<<<" "RTN","SD53P754",134,0) . S FDA(409.85,AP_",",22)="@" "RTN","SD53P754",135,0) . D UPDATE^DIE(,"FDA","ERR") "RTN","SD53P754",136,0) . K ^SDEC(409.85,AP,"DIS") "RTN","SD53P754",137,0) Q "RTN","SDHL7APT") 0^2^B272423848^B270646234 "RTN","SDHL7APT",1,0) SDHL7APT ;MS/TG,PH - TMP HL7 Routine;AUG 17, 2018 "RTN","SDHL7APT",2,0) ;;5.3;Scheduling;**704,714,754**;AUG 17, 2018;Build 5 "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^SDHLAPT2(%) "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=$$CONVTIME^SDHL7APU(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 "VER") 8.0^22.2 "BLD",11688,6) ^613 **END** **END**