Released SD*5.3*817 SEQ #678 Extracted from mail message **KIDS**:SD*5.3*817^ **INSTALL NAME** SD*5.3*817 "BLD",11982,0) SD*5.3*817^SCHEDULING^0^3220912^y "BLD",11982,1,0) ^^2^2^3220525^ "BLD",11982,1,1,0) The description of this build can be found in the National Patch Module "BLD",11982,1,2,0) under SD*5.3*817. "BLD",11982,4,0) ^9.64PA^^ "BLD",11982,6) 4^ "BLD",11982,6.3) 7 "BLD",11982,"KRN",0) ^9.67PA^1.5^25 "BLD",11982,"KRN",.4,0) .4 "BLD",11982,"KRN",.401,0) .401 "BLD",11982,"KRN",.402,0) .402 "BLD",11982,"KRN",.403,0) .403 "BLD",11982,"KRN",.5,0) .5 "BLD",11982,"KRN",.84,0) .84 "BLD",11982,"KRN",1.5,0) 1.5 "BLD",11982,"KRN",1.6,0) 1.6 "BLD",11982,"KRN",1.61,0) 1.61 "BLD",11982,"KRN",1.62,0) 1.62 "BLD",11982,"KRN",3.6,0) 3.6 "BLD",11982,"KRN",3.8,0) 3.8 "BLD",11982,"KRN",9.2,0) 9.2 "BLD",11982,"KRN",9.8,0) 9.8 "BLD",11982,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",11982,"KRN",9.8,"NM",1,0) SDTMPEDT^^0^B15166474 "BLD",11982,"KRN",9.8,"NM",2,0) SDTMPUT0^^0^B101063236 "BLD",11982,"KRN",9.8,"NM",3,0) SDHL7APT^^0^B248427400 "BLD",11982,"KRN",9.8,"NM",4,0) SDTMPUT2^^0^B46095434 "BLD",11982,"KRN",9.8,"NM","B","SDHL7APT",3) "BLD",11982,"KRN",9.8,"NM","B","SDTMPEDT",1) "BLD",11982,"KRN",9.8,"NM","B","SDTMPUT0",2) "BLD",11982,"KRN",9.8,"NM","B","SDTMPUT2",4) "BLD",11982,"KRN",19,0) 19 "BLD",11982,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",11982,"KRN",19,"NM",1,0) SD DEFAULT PROVIDER UPDATE^^0 "BLD",11982,"KRN",19,"NM",2,0) SD TELE TOOLS^^2 "BLD",11982,"KRN",19,"NM","B","SD DEFAULT PROVIDER UPDATE",1) "BLD",11982,"KRN",19,"NM","B","SD TELE TOOLS",2) "BLD",11982,"KRN",19.1,0) 19.1 "BLD",11982,"KRN",101,0) 101 "BLD",11982,"KRN",409.61,0) 409.61 "BLD",11982,"KRN",771,0) 771 "BLD",11982,"KRN",779.2,0) 779.2 "BLD",11982,"KRN",870,0) 870 "BLD",11982,"KRN",8989.51,0) 8989.51 "BLD",11982,"KRN",8989.52,0) 8989.52 "BLD",11982,"KRN",8993,0) 8993 "BLD",11982,"KRN",8994,0) 8994 "BLD",11982,"KRN","B",.4,.4) "BLD",11982,"KRN","B",.401,.401) "BLD",11982,"KRN","B",.402,.402) "BLD",11982,"KRN","B",.403,.403) "BLD",11982,"KRN","B",.5,.5) "BLD",11982,"KRN","B",.84,.84) "BLD",11982,"KRN","B",1.5,1.5) "BLD",11982,"KRN","B",1.6,1.6) "BLD",11982,"KRN","B",1.61,1.61) "BLD",11982,"KRN","B",1.62,1.62) "BLD",11982,"KRN","B",3.6,3.6) "BLD",11982,"KRN","B",3.8,3.8) "BLD",11982,"KRN","B",9.2,9.2) "BLD",11982,"KRN","B",9.8,9.8) "BLD",11982,"KRN","B",19,19) "BLD",11982,"KRN","B",19.1,19.1) "BLD",11982,"KRN","B",101,101) "BLD",11982,"KRN","B",409.61,409.61) "BLD",11982,"KRN","B",771,771) "BLD",11982,"KRN","B",779.2,779.2) "BLD",11982,"KRN","B",870,870) "BLD",11982,"KRN","B",8989.51,8989.51) "BLD",11982,"KRN","B",8989.52,8989.52) "BLD",11982,"KRN","B",8993,8993) "BLD",11982,"KRN","B",8994,8994) "BLD",11982,"QDEF") ^^^^NO^^^^NO^^NO "BLD",11982,"QUES",0) ^9.62^^ "BLD",11982,"REQB",0) ^9.611^2^2 "BLD",11982,"REQB",1,0) SD*5.3*812^2 "BLD",11982,"REQB",2,0) SD*5.3*810^2 "BLD",11982,"REQB","B","SD*5.3*810",2) "BLD",11982,"REQB","B","SD*5.3*812",1) "KRN",19,17862,-1) 2^2 "KRN",19,17862,0) SD TELE TOOLS^Telehealth Management Toolbox^^M^233794^^^^^^^ "KRN",19,17862,10,0) ^19.01IP^7^7 "KRN",19,17862,10,7,0) 17936^DEF^5 "KRN",19,17862,10,7,"^") SD DEFAULT PROVIDER UPDATE "KRN",19,17862,"U") TELEHEALTH MANAGEMENT TOOLBOX "KRN",19,17936,-1) 0^1 "KRN",19,17936,0) SD DEFAULT PROVIDER UPDATE^Default Provider Bulk Update^^R^^^^^^^^ "KRN",19,17936,1,0) ^^6^6^3220527^ "KRN",19,17936,1,1,0) This option provides users with the ability to bulk update Default "KRN",19,17936,1,2,0) Provider for dedicated clinics. A dedicated clinic is one in which only "KRN",19,17936,1,3,0) one provider is found with a Default Provider flag. The bulk update "KRN",19,17936,1,4,0) operation should be allowed on dedicated clinics only. If a clinic is "KRN",19,17936,1,5,0) shared clinic with multiple providers, no updates will take place. "KRN",19,17936,1,6,0) Telehealth patient clinics are restricted. "KRN",19,17936,25) EN^SDTMPUT2 "KRN",19,17936,"U") DEFAULT PROVIDER BULK UPDATE "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) 817^3220912^233794 "PKG",16,22,1,"PAH",1,1,0) ^^2^2^3220912 "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*817. "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") 4 "RTN","SDHL7APT") 0^3^B248427400^B244397644 "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,780,798,810,817**;AUG 17, 2018;Build 7 "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) ; Integration Agreements: NONE "RTN","SDHL7APT",26,0) ; "RTN","SDHL7APT",27,0) N MSGROOT,DATAROOT,QRY,XMT,ERR,RNAME,IX,REQIEN ;817 reqien "RTN","SDHL7APT",28,0) K SDTMPHL "RTN","SDHL7APT",29,0) S (MSGROOT,QRY,XMT,ERR,RNAME)="" "RTN","SDHL7APT",30,0) S U="^" "RTN","SDHL7APT",31,0) ; "RTN","SDHL7APT",32,0) ; Inbound SIU messages are small enough to be held in a local array. "RTN","SDHL7APT",33,0) ; The following lines commented out support use of temporary globals and are "RTN","SDHL7APT",34,0) ; left for debugging purposes. "RTN","SDHL7APT",35,0) ; "RTN","SDHL7APT",36,0) S MSGROOT="SDHL7APT" "RTN","SDHL7APT",37,0) K @MSGROOT "RTN","SDHL7APT",38,0) N EIN "RTN","SDHL7APT",39,0) S EIN=$$FIND1^DIC(101,,,"SD TMP S12 SERVER EVENT DRIVER") "RTN","SDHL7APT",40,0) ; "RTN","SDHL7APT",41,0) D LOADXMT^SDHL7APU(.HL,.XMT) ;Load inbound message information "RTN","SDHL7APT",42,0) K ACKMSG S ACKMSG=$G(HL("MID")) "RTN","SDHL7APT",43,0) S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER" "RTN","SDHL7APT",44,0) ; "RTN","SDHL7APT",45,0) N CNT,SEG "RTN","SDHL7APT",46,0) K @MSGROOT "RTN","SDHL7APT",47,0) D LOADMSG^SDHL7APU(MSGROOT) "RTN","SDHL7APT",48,0) ; "RTN","SDHL7APT",49,0) D PARSEMSG^SDHL7APU(MSGROOT,.HL) "RTN","SDHL7APT",50,0) ; "RTN","SDHL7APT",51,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",52,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",53,0) N SDECCR,SDECEND,SDECLEN,SDECNOTE,SDECRES,SDECSTART,SDECY,SDEKG,SDEL,SDID,SDLAB,SDMRTC,SDPARENT,SDCHILD,SDECAPTID,SDECDATE,FIRST "RTN","SDHL7APT",54,0) N SDREQBY,SDSVCP,SDSVCPR,SDECCR,INTRA,SDXRAY,SEGTYPE,INST,FLMNFMT2,SDAPTYP,SETID,STA,STATUS,STOP,PROVIEN,ERRCND,ERRSND,ERRTXT,URL,MSH,SDECNOT "RTN","SDHL7APT",55,0) ; "RTN","SDHL7APT",56,0) S (MSGCONID,SCHDFN)="" "RTN","SDHL7APT",57,0) S CNT=1,SETID=1,PREVSEG="",GRPCNT=0,PTIEN="",ERRTXT="",ERRSND="" "RTN","SDHL7APT",58,0) ; "RTN","SDHL7APT",59,0) ; Loop to receive HL7 message segments. "RTN","SDHL7APT",60,0) S ERR=0 "RTN","SDHL7APT",61,0) F Q:'$D(@MSGROOT@(CNT)) Q:ERR D S CNT=CNT+1,PREVSEG=SEGTYPE "RTN","SDHL7APT",62,0) .S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7APT",63,0) .I SEGTYPE="MSH" M MSH=@MSGROOT@(CNT) Q "RTN","SDHL7APT",64,0) .I SEGTYPE="SCH" M SCH=@MSGROOT@(CNT) Q "RTN","SDHL7APT",65,0) .I SEGTYPE="NTE",(PREVSEG="SCH") M SCHNTE=@MSGROOT@(CNT) Q "RTN","SDHL7APT",66,0) .I SEGTYPE="PID" M PID=@MSGROOT@(CNT) Q "RTN","SDHL7APT",67,0) .I SEGTYPE="PV1" M PV1=@MSGROOT@(CNT) Q "RTN","SDHL7APT",68,0) .I SEGTYPE="OBX" M OBX=@MSGROOT@(CNT) Q "RTN","SDHL7APT",69,0) .I SEGTYPE="RGS" D Q "RTN","SDHL7APT",70,0) ..S SETID=$G(@MSGROOT@(CNT,1)) "RTN","SDHL7APT",71,0) ..I +SETID=0 S ERR=1,ERRTXT="Invalid RGS SetID received" Q "RTN","SDHL7APT",72,0) ..M RGS(SETID)=@MSGROOT@(CNT) "RTN","SDHL7APT",73,0) ..S GRPCNT=GRPCNT+1 "RTN","SDHL7APT",74,0) ..Q "RTN","SDHL7APT",75,0) .I SEGTYPE="AIS" M AIS(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",76,0) .I SEGTYPE="NTE",(PREVSEG="AIS") M AISNTE(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",77,0) .I SEGTYPE="AIG" M AIG(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",78,0) .I SEGTYPE="NTE",(PREVSEG="AIG") M AIGNTE(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",79,0) .I SEGTYPE="AIL" M AIL(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",80,0) .I SEGTYPE="NTE",(PREVSEG="AIL") M AILNTE(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",81,0) .I SEGTYPE="AIP" M AIP(SETID)=@MSGROOT@(CNT) Q "RTN","SDHL7APT",82,0) .I SEGTYPE="NTE",(PREVSEG="AIP") M AIPNTE(SETID)=@MSGROOT@(CNT) "RTN","SDHL7APT",83,0) .Q "RTN","SDHL7APT",84,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",85,0) .I $G(AIL(2,4))=$G(AIL(1,4)) S AIL(2,4)="",AIL(2,4)="" "RTN","SDHL7APT",86,0) ; "RTN","SDHL7APT",87,0) S MSAHDR="MSA^1^^100^AE^" "RTN","SDHL7APT",88,0) I +ERR D Q "RTN","SDHL7APT",89,0) .S ERR=$G(MSAHDR)_$E(ERRTXT,1,50) "RTN","SDHL7APT",90,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",91,0) .K @MSGROOT "RTN","SDHL7APT",92,0) .Q "RTN","SDHL7APT",93,0) ; "RTN","SDHL7APT",94,0) K SCHNW,INP,PCE,SCPER,ATYPIEN "RTN","SDHL7APT",95,0) ; "RTN","SDHL7APT",96,0) ; Loop to populate MSGARY, INP arrays which are used in ^SDECAR2 (to create appt request) and ^SDEC07 (to create appt) "RTN","SDHL7APT",97,0) N MSGARY,SDCL2,SDCL3 "RTN","SDHL7APT",98,0) D MSH^SDHL7APU(.MSH,.INP,.MSGARY) "RTN","SDHL7APT",99,0) D SCH^SDHL7APU(.SCH,.INP,.MSGARY) "RTN","SDHL7APT",100,0) D SCHNTE^SDHL7APU(.SCHNTE,.INP,.MSGARY) "RTN","SDHL7APT",101,0) D PID^SDHL7APU(.PID,.INP,.MSGARY) "RTN","SDHL7APT",102,0) D PV1^SDHL7APU(.PV1,.INP,.MSGARY) "RTN","SDHL7APT",103,0) D OBX^SDHL7APU(.OBX,.INP) "RTN","SDHL7APT",104,0) F IX=1:1:GRPCNT D "RTN","SDHL7APT",105,0) .D RGS^SDHL7APU(.RGS,IX,.INP) "RTN","SDHL7APT",106,0) .D AIS^SDHL7APU(.AIS,IX,.INP,.MSGARY) "RTN","SDHL7APT",107,0) .D AISNTE^SDHL7APU(.AISNTE,IX,.INP) "RTN","SDHL7APT",108,0) .D AIG^SDHL7APU(.AIG,IX,.INP) "RTN","SDHL7APT",109,0) .D AIGNTE^SDHL7APU(.AIGNTE,IX,.INP) "RTN","SDHL7APT",110,0) .D AIL^SDHL7APU(.AIL,IX,.INP,.MSGARY) "RTN","SDHL7APT",111,0) .D AILNTE^SDHL7APU(.AILNTE,IX,.INP) "RTN","SDHL7APT",112,0) .D AIP^SDHL7APU(.AIP,IX,.INP,.MSGARY) "RTN","SDHL7APT",113,0) .D AIPNTE^SDHL7APU(.AIPNTE,IX,.INP) "RTN","SDHL7APT",114,0) .Q "RTN","SDHL7APT",115,0) N %,NOW "RTN","SDHL7APT",116,0) D NOW^%DTC S CURDTTM=$$TMCONV^SDTMPHLA(%,$$KSP^XUPARAM("INST")) ;773 "RTN","SDHL7APT",117,0) S NOW=$$HTFM^XLFDT($H),INP(3)=$$FMTE^XLFDT(NOW) "RTN","SDHL7APT",118,0) S INP(11)=INP(3) "RTN","SDHL7APT",119,0) S INP(5)="APPT" "RTN","SDHL7APT",120,0) S INP(8)="FUTURE" "RTN","SDHL7APT",121,0) ; "RTN","SDHL7APT",122,0) N X11 S X11=$P($G(SDAPTYP),"|") S:$G(X11)="" X11="A" "RTN","SDHL7APT",123,0) S INP(9)=$S(X11="A":"PATIENT",1:"PROVIDER") ;request by provider or patient. RTC orders and consults will always be PROVIDER otherwise it is PATIENT "RTN","SDHL7APT",124,0) ; "RTN","SDHL7APT",125,0) K DFN "RTN","SDHL7APT",126,0) S (DFN,INP(2))=$$GETDFN^MPIF001(MSGARY("MPI")) "RTN","SDHL7APT",127,0) I $P(DFN,U,2)="NO ICN"!($P(DFN,U,2)="ICN NOT IN DATABASE") D Q "RTN","SDHL7APT",128,0) .S ERR=$G(MSAHDR)_"PATIENT ICN NOT FOUND" "RTN","SDHL7APT",129,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",130,0) .K @MSGROOT "RTN","SDHL7APT",131,0) .Q "RTN","SDHL7APT",132,0) ; "RTN","SDHL7APT",133,0) N STOPME "RTN","SDHL7APT",134,0) I $P($G(SDAPTYP),"|",1)="C"!($P($G(SDAPTYP),"|",1)="R") D CHKCON^SDHLAPT2(DFN,SDAPTYP) I $G(STOPME)=1 Q "RTN","SDHL7APT",135,0) ; "RTN","SDHL7APT",136,0) I $G(SDCL)="" D Q "RTN","SDHL7APT",137,0) .S ERR=$G(MSAHDR)_"CLINIC ID IS NULL",STOPME=1 "RTN","SDHL7APT",138,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",139,0) .K @MSGROOT "RTN","SDHL7APT",140,0) .Q "RTN","SDHL7APT",141,0) ; "RTN","SDHL7APT",142,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",143,0) ; "RTN","SDHL7APT",144,0) I '$D(^SC($G(SDCL),0)) D Q "RTN","SDHL7APT",145,0) .Q:$G(AIL(1,3,1,4))'=$P(^DIC(4,$$KSP^XUPARAM("INST"),99),"^") "RTN","SDHL7APT",146,0) .S ERR=$G(MSAHDR)_"NOT A CLINIC AT THIS SITE "_$G(SDCL) "RTN","SDHL7APT",147,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",148,0) .K @MSGROOT "RTN","SDHL7APT",149,0) .Q "RTN","SDHL7APT",150,0) ; "RTN","SDHL7APT",151,0) S STOPME=0 "RTN","SDHL7APT",152,0) I $G(SDCL2)>0 D "RTN","SDHL7APT",153,0) .Q:$G(AIL(2,3,1,4))'=$P(^DIC(4,$$KSP^XUPARAM("INST"),99),"^") "RTN","SDHL7APT",154,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",155,0) .K @MSGROOT "RTN","SDHL7APT",156,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",157,0) K INP D INP^SDHL7APU "RTN","SDHL7APT",158,0) ; "RTN","SDHL7APT",159,0) S RET="" "RTN","SDHL7APT",160,0) ;IF a regular appt, not rtc or consult check to see if the appointment is in 409.85 "RTN","SDHL7APT",161,0) I $P(SDAPTYP,"|",1)="A" D "RTN","SDHL7APT",162,0) .Q:$$UPPER^SDUL1(MSGARY("HL7EVENT"))'="S12" "RTN","SDHL7APT",163,0) .S:INP(3)="" INP(3)=DT S RTN=0 D ARSET^SDECAR2(.RTN,.INP) "RTN","SDHL7APT",164,0) .S REQIEN=+$P(RTN,$c(30),2),SDAPTYP="A|"_REQIEN ;817- define REQIEN for later ;810- SDECAR2 routine should be used instead of SDHLAPT1 version of ARSET "RTN","SDHL7APT",165,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",166,0) ;714 - PB get the division associated with the clinic and pass to the function to convert utc to local time "RTN","SDHL7APT",167,0) N TMPSTART,D1,D2 "RTN","SDHL7APT",168,0) S:$G(SDCL)>0 D1=$P(^SC(SDCL,0),"^",15),D2=$$GET1^DIQ(40.8,D1_",",.07,"I") "RTN","SDHL7APT",169,0) S FLMNFMT=$$JSONTFM^SDHLAPT2(SDECSTART,D2),TMPSTART=FLMNFMT,SDECSTART=$$FMTE^XLFDT(FLMNFMT) "RTN","SDHL7APT",170,0) I FLMNFMT<1 D Q "RTN","SDHL7APT",171,0) .S ERR=$G(MSAHDR)_"Invalid Start Date sent" "RTN","SDHL7APT",172,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",173,0) .K @MSGROOT "RTN","SDHL7APT",174,0) .Q "RTN","SDHL7APT",175,0) ; "RTN","SDHL7APT",176,0) ;PB - 714 fix to stop duplicate appointments for the patient "RTN","SDHL7APT",177,0) S STOPME=0 "RTN","SDHL7APT",178,0) I $G(^DPT(DFN,"S",FLMNFMT,0))&($G(MSGARY("HL7EVENT"))="S12") D "RTN","SDHL7APT",179,0) .Q:$P($G(^DPT(DFN,"S",FLMNFMT,0)),"^",2)["C" "RTN","SDHL7APT",180,0) .S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT),STOPME=1 "RTN","SDHL7APT",181,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",182,0) .K @MSGROOT "RTN","SDHL7APT",183,0) .Q "RTN","SDHL7APT",184,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",185,0) S STOPME=0 "RTN","SDHL7APT",186,0) I $G(INTRA)=1 D "RTN","SDHL7APT",187,0) .S FLMNFMT2=$$FMADD^XLFDT(FLMNFMT,,,5) "RTN","SDHL7APT",188,0) .Q:$G(MSGARY("HL7EVENT"))'="S12" "RTN","SDHL7APT",189,0) .I $D(^DPT(DFN,"S",FLMNFMT,0)) D "RTN","SDHL7APT",190,0) ..I $P($G(^DPT(DFN,"S",FLMNFMT,0)),"^",2)'["C" D "RTN","SDHL7APT",191,0) ...S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT2),STOPME=1 "RTN","SDHL7APT",192,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",193,0) ...K @MSGROOT "RTN","SDHL7APT",194,0) .Q:$G(STOPME)=1 "RTN","SDHL7APT",195,0) .I $D(^DPT(DFN,"S",FLMNFMT2,0)) D "RTN","SDHL7APT",196,0) ..I $P($G(^DPT(DFN,"S",FLMNFMT2,0)),"^",2)'["C" D "RTN","SDHL7APT",197,0) ...S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT2),STOPME=1 "RTN","SDHL7APT",198,0) ...D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",199,0) ...K @MSGROOT "RTN","SDHL7APT",200,0) .Q "RTN","SDHL7APT",201,0) Q:$G(STOPME)=1 "RTN","SDHL7APT",202,0) I $L(SDECLEN),$L($G(SCH(10))) D "RTN","SDHL7APT",203,0) .I $G(SCH(10))="MIN" S SDECEND=$$FMADD^XLFDT(FLMNFMT,,,$G(SDECLEN)) "RTN","SDHL7APT",204,0) .I $G(SCH(10))="HR" S SDECEND=$$FMADD^XLFDT(FLMNFMT,,$G(SDECLEN)) "RTN","SDHL7APT",205,0) .Q "RTN","SDHL7APT",206,0) ; "RTN","SDHL7APT",207,0) N TMPARR,LEN "RTN","SDHL7APT",208,0) S LEN=0,ERRSND=0,ERRTXT="",MSGROOT="SDTMPHL" "RTN","SDHL7APT",209,0) K @MSGROOT "RTN","SDHL7APT",210,0) ; Loop to send RGS>1 groups to remote facilities. Abort entire SIU if any facility returns AE from remote. "RTN","SDHL7APT",211,0) F GRPNO=2:1:GRPCNT D Q:+ERRSND "RTN","SDHL7APT",212,0) .K @MSGROOT "RTN","SDHL7APT",213,0) .S CNT=1,INTRA=0 "RTN","SDHL7APT",214,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",215,0) .I $D(SCHNTE) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.SCHNTE,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",216,0) .I $D(PID) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PID,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",217,0) .I $D(PV1) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PV1,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",218,0) .M TMPARR=RGS(GRPNO) "RTN","SDHL7APT",219,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",220,0) .K TMPARR "RTN","SDHL7APT",221,0) .M TMPARR=AIS(GRPNO) "RTN","SDHL7APT",222,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",223,0) .K TMPARR "RTN","SDHL7APT",224,0) .M TMPARR=AISNTE(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=AIG(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=AIL(GRPNO) "RTN","SDHL7APT",231,0) .I $D(TMPARR) D "RTN","SDHL7APT",232,0) ..S STA=$G(TMPARR(3,1,4)) S STA=$$GETSTA^SDHL7APU(STA) "RTN","SDHL7APT",233,0) ..S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",234,0) .K TMPARR "RTN","SDHL7APT",235,0) .M TMPARR=AILNTE(GRPNO) "RTN","SDHL7APT",236,0) .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7APT",237,0) .K TMPARR "RTN","SDHL7APT",238,0) .M TMPARR=AIP(GRPNO) "RTN","SDHL7APT",239,0) .I $D(TMPARR) 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=AIPNTE(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) .S:$G(AIL(1,3,1,4))=$G(AIL(2,3,1,4)) INTRA=1 "RTN","SDHL7APT",245,0) .I $G(INTRA)=1 D NEWTIME^SDHLAPT2 "RTN","SDHL7APT",246,0) .N HLRESLT,X "RTN","SDHL7APT",247,0) .I $G(INTRA)=0 D "RTN","SDHL7APT",248,0) ..I '$$CHKLL^HLUTIL($G(STA)) D Q "RTN","SDHL7APT",249,0) ...S ERRSND=1,ERRTXT=$E("Invalid Link assoc with institution: "_$G(STA),1,48) "RTN","SDHL7APT",250,0) ..Q "RTN","SDHL7APT",251,0) .K HLA,HLEVN "RTN","SDHL7APT",252,0) .N MC,HLFS,HLCS,IXX "RTN","SDHL7APT",253,0) .F IXX=1:1:CNT S HLA("HLS",IXX)=$G(@MSGROOT@(IXX)) "RTN","SDHL7APT",254,0) .M HLA("HLA")=HLA("HLS") "RTN","SDHL7APT",255,0) .S EIN=$$FIND1^DIC(101,,,"SD IFS EVENT DRIVER") "RTN","SDHL7APT",256,0) .;the following HL* variables are created by DIRECT^HLMA "RTN","SDHL7APT",257,0) .N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN,HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQ,HLQUITQ,SDLINK,OROK,MSASEG,ERRRSP "RTN","SDHL7APT",258,0) .; "RTN","SDHL7APT",259,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",260,0) ..K HL "RTN","SDHL7APT",261,0) ..D:$G(INTRA)=0 INIT^HLFNC2("SD IFS EVENT DRIVER",.HL) "RTN","SDHL7APT",262,0) ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND INTRAFACILITY",.HL) ;if intra "RTN","SDHL7APT",263,0) ..Q "RTN","SDHL7APT",264,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",265,0) ..K HL "RTN","SDHL7APT",266,0) ..D:$G(INTRA)=0 INIT^HLFNC2("SD TMP S15 SERVER EVENT DRIVER",.HL) "RTN","SDHL7APT",267,0) ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND CANCEL INTRA",.HL) ;if intra "RTN","SDHL7APT",268,0) ..Q "RTN","SDHL7APT",269,0) .I $G(STA)="" S STA=$G(AIL(2,3,1,4)),STA=$$GETSTA^SDHL7APU(STA) "RTN","SDHL7APT",270,0) .D LINK^HLUTIL3(STA,.SDLINK,"I") "RTN","SDHL7APT",271,0) .S SDLINK=$O(SDLINK(0)) "RTN","SDHL7APT",272,0) .I SDLINK="" D Q "RTN","SDHL7APT",273,0) ..Q:$G(INTRA)=1 "RTN","SDHL7APT",274,0) ..S ERRSND=1,ERRTXT=$E("Message link undefined for facility: "_$G(STA),1,48) "RTN","SDHL7APT",275,0) ..Q "RTN","SDHL7APT",276,0) .S SDLINK=SDLINK(SDLINK) "RTN","SDHL7APT",277,0) .;817 removed code setting HLL("LINKS") for INTRA type appts. Not used for internal HL7 processing. TMP-1559 "RTN","SDHL7APT",278,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",279,0) ..S:$G(INTRA)=0 HLL("LINKS",1)="SD IFS SUBSCRIBER"_U_$G(SDLINK) "RTN","SDHL7APT",280,0) ..Q "RTN","SDHL7APT",281,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",282,0) ..S:$G(INTRA)=0 HLL("LINKS",1)="SD TMP S15 CLIENT SUBSCRIBER"_U_$G(SDLINK) "RTN","SDHL7APT",283,0) ..Q "RTN","SDHL7APT",284,0) .S HLMTIEN="" "RTN","SDHL7APT",285,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",286,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",287,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",288,0) ..Q "RTN","SDHL7APT",289,0) .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D "RTN","SDHL7APT",290,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",291,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",292,0) ..Q "RTN","SDHL7APT",293,0) .I 'HLMTIEN D Q "RTN","SDHL7APT",294,0) ..S ERRSND=1,ERRTXT=$E("Message sent to remote facility unsuccessful: "_$G(STA),1,48) "RTN","SDHL7APT",295,0) ..Q "RTN","SDHL7APT",296,0) .K @MSGROOT "RTN","SDHL7APT",297,0) .;Process response "RTN","SDHL7APT",298,0) .;NOTE: OCT 25 - need to test this to see if it will quit properly "RTN","SDHL7APT",299,0) .I $G(INTRA)=0 D "RTN","SDHL7APT",300,0) ..N HLNODE,SEG,I,RESP,IK "RTN","SDHL7APT",301,0) ..;H 2 "RTN","SDHL7APT",302,0) ..F IK=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7APT",303,0) ...S RESP(IK)=HLNODE "RTN","SDHL7APT",304,0) ...Q "RTN","SDHL7APT",305,0) ..S MSASEG=$G(RESP(2)) "RTN","SDHL7APT",306,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",307,0) .Q "RTN","SDHL7APT",308,0) ; "RTN","SDHL7APT",309,0) I +ERRSND D Q "RTN","SDHL7APT",310,0) .S ERR=$G(MSAHDR)_ERRTXT "RTN","SDHL7APT",311,0) .D SENDERR^SDHL7APU(ERR) "RTN","SDHL7APT",312,0) .K @MSGROOT "RTN","SDHL7APT",313,0) .Q "RTN","SDHL7APT",314,0) K @MSGROOT "RTN","SDHL7APT",315,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APT",316,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APT",317,0) S (SDSVCP,SDSVCPR,SDEKG,SDXRAY,SDLAB,SDECCR,SDECY,SDID,APPTYPE,EESTAT,SDEL)="",SDCL=$G(AIL(1,3,1,1)) "RTN","SDHL7APT",318,0) S SDECRES=$$RESLKUP^SDHL7APU($G(SDCL)) "RTN","SDHL7APT",319,0) S SDECRES=SDECRES,OVB=1 "RTN","SDHL7APT",320,0) S (SDMRTC,MSGARY("SDMRTC"))=$S($G(SDMRTC)=1:"TRUE",1:"FALSE"),SDLAB="",PROVIEN=MSGARY("PROVIEN") "RTN","SDHL7APT",321,0) I $P(SDAPTYP,"|",1)="R" D "RTN","SDHL7APT",322,0) .S $P(SDAPTYP,"|",1)="A" "RTN","SDHL7APT",323,0) .I $P(SDAPTYP,"|",2)=$G(SDPARENT) S:$P($G(^SDEC(409.85,$G(SDPARENT),3)),"^")="" SDPARENT="" "RTN","SDHL7APT",324,0) K INP D INP^SDHL7APU "RTN","SDHL7APT",325,0) S (ERRCND,ERRTXT)="" "RTN","SDHL7APT",326,0) N SUCCESS "RTN","SDHL7APT",327,0) S SUCCESS=0 "RTN","SDHL7APT",328,0) S (PROVIEN,DUZ)=$G(MSGARY("DUZ")) "RTN","SDHL7APT",329,0) S:$G(DUZ)="" (PROVIEN,DUZ)=.5 "RTN","SDHL7APT",330,0) S:$G(DUZ(2))="" DUZ(2)=$G(MSGARY("HLTHISSITE")) "RTN","SDHL7APT",331,0) S (INP(11),SDDDT)=$G(SCH(11,1,8)) "RTN","SDHL7APT",332,0) ;Begin S12 processing (make) "RTN","SDHL7APT",333,0) I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D "RTN","SDHL7APT",334,0) .S URL=$G(AILNTE) "RTN","SDHL7APT",335,0) .I $P($G(SDAPTYP),"|")="A"&($G(SDAPT)>0) D "RTN","SDHL7APT",336,0) ..S $P(SDAPTYP,"|",2)=SDAPT "RTN","SDHL7APT",337,0) ..S:$G(SDDDT)="" (INP(11),SDDDT)=$P(SDECSTART,"@",1),SDECATID="WALKIN" "RTN","SDHL7APT",338,0) .S:$P($G(SDAPTYP),"|",1)="R" $P(SDAPTYP,"|",1)="A" "RTN","SDHL7APT",339,0) .S:$G(SDPARENT)=$P(SDAPTYP,"|",2) SDPARENT="" "RTN","SDHL7APT",340,0) .I $$APPTYPE^SDHL7APU(SDCL)=1 S APPTYPE=1 ;780 "RTN","SDHL7APT",341,0) .I $$PATCH^XPDUTL("SD*5.3*694") S SDECEND=$$FMTE^XLFDT(SDECEND) "RTN","SDHL7APT",342,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",343,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",344,0) .S URL=$G(AILNTE) "RTN","SDHL7APT",345,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",346,0) .N TMP2 S TMP2=$G(^TMP("SDEC07",$J,2)) "RTN","SDHL7APT",347,0) .I ((+$P(TMP2,"^",1)>0)&($L($P(TMP2,"^",3))<1)) S SUCCESS=1 "RTN","SDHL7APT",348,0) .I SUCCESS=0 S ERRTXT=$P($G(^TMP("SDEC07",$J,2)),"^",3) "RTN","SDHL7APT",349,0) .I ((SUCCESS=0)&(ERRTXT="")) D "RTN","SDHL7APT",350,0) ..S ERRTXT=$P($G(^TMP("SDEC07",$J,3)),"^",2) "RTN","SDHL7APT",351,0) ..Q "RTN","SDHL7APT",352,0) .I $L(ERRTXT) S ERRCND=9999 "RTN","SDHL7APT",353,0) .S DUZ(2)=$G(STA) "RTN","SDHL7APT",354,0) .I $G(SUCCESS)>0 D "RTN","SDHL7APT",355,0) ..N INPA S INPA(1)=$S($G(REQIEN):REQIEN,1:$P(SDAPTYP,"|",2)),INPA(2)="SA",INPA(3)=$G(DUZ),DUZ(2)=$G(STA) ;INPA(1) is the IEN of the PARENT order ;817 If RTC, then add new Req (i.e. REQIEN) will exist. "RTN","SDHL7APT",356,0) ..S INPA(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",357,0) ..N RET D ARCLOSE^SDECAR(.RET,.INPA) ; Dispositions the order. "RTN","SDHL7APT",358,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",359,0) ..I $G(CLOSEOUT)=1 D ;if this is the last child close out the parent and all child orders "RTN","SDHL7APT",360,0) ...N INP S INP(1)=+SDPARENT,INP(2)="SA",INP(3)=$G(DUZ),DUZ(2)=$G(STA) "RTN","SDHL7APT",361,0) ...S INP(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",362,0) ...D ARCLOSE^SDECAR(.RET,.INP) "RTN","SDHL7APT",363,0) ...;Parent Appointment Request Closed now loop thru the 3 node and update each of the children to disposition of "MC" "RTN","SDHL7APT",364,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",365,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",366,0) ....S INP(4)=$$FMTE^XLFDT(DT) "RTN","SDHL7APT",367,0) ....D ARCLOSE^SDECAR(.RET,.INP) "RTN","SDHL7APT",368,0) ....Q "RTN","SDHL7APT",369,0) ...;S $P(^SDEC(409.85,+SDPARENT,0),"^",5)="APPT" "RTN","SDHL7APT",370,0) ...Q "RTN","SDHL7APT",371,0) ..Q "RTN","SDHL7APT",372,0) .Q "RTN","SDHL7APT",373,0) ;SECAPPT ; If this is an intrafacility appointment make the second appointment <0 S ERRCND=9999 "RTN","SDHL7APT",387,0) .D CHKCAN^SDHLAPT2(DFN,SDCL,STARTDT) "RTN","SDHL7APT",388,0) ; "RTN","SDHL7APT",389,0) I +ERRCND D "RTN","SDHL7APT",390,0) .S ERRTXT=$$ERRLKP^SDHL7APU(ERRTXT) "RTN","SDHL7APT",391,0) .Q "RTN","SDHL7APT",392,0) S ERRTXT=$$STRIP^SDHL7APU(ERRTXT) "RTN","SDHL7APT",393,0) ; "RTN","SDHL7APT",394,0) ;****BUILD THE RESPONSE MSA "RTN","SDHL7APT",395,0) K @MSGROOT "RTN","SDHL7APT",396,0) N HLA "RTN","SDHL7APT",397,0) ; "RTN","SDHL7APT",398,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7APT",399,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7APT",400,0) ; "RTN","SDHL7APT",401,0) N ERR,LEN S ERR="" "RTN","SDHL7APT",402,0) N FOUNDCN "RTN","SDHL7APT",403,0) S FOUNDCN=0 "RTN","SDHL7APT",404,0) ; "RTN","SDHL7APT",405,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",406,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7APT",407,0) Q "RTN","SDTMPEDT") 0^1^B15166474^B12954878 "RTN","SDTMPEDT",1,0) SDTMPEDT ;MS/SJA - TELEHEALTH STOP CODES EDIT ;Dec 17, 2020 "RTN","SDTMPEDT",2,0) ;;5.3;Scheduling;**773,779,780,817**;Aug 13, 1993;Build 7 "RTN","SDTMPEDT",3,0) ; "RTN","SDTMPEDT",4,0) ; "RTN","SDTMPEDT",5,0) EDIT ; Add/edit stop code entries in file #40.6 "RTN","SDTMPEDT",6,0) N ADD,DEL,Y,X,STOPCODE,X1,GOOD,TMPERR "RTN","SDTMPEDT",7,0) S GOOD=0,X1=0,(ADD,DEL)=0 "RTN","SDTMPEDT",8,0) K DIR,DTOUT,DUOUT "RTN","SDTMPEDT",9,0) W ! S DIR(0)="N",DIR("A")="Enter Stop Code" "RTN","SDTMPEDT",10,0) S DIR("?")="This is the stop code to added or deleted" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) G EXIT "RTN","SDTMPEDT",11,0) S STOPCODE=Y "RTN","SDTMPEDT",12,0) S GOOD=$$CHKSTOP(STOPCODE) ;check to see if valid stop code in 40.7, message to user and quit if not valid "RTN","SDTMPEDT",13,0) I GOOD'>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","SDTMPEDT",48,0) PROVID ; provider fields add/edit "RTN","SDTMPEDT",49,0) N CLNDA,JJ,PRIEN,SEQ,TXT "RTN","SDTMPEDT",50,0) W !!!,$C(7),"CAUTION: DO NOT USE - Default Provider for setting up a Shared or Patient Site",!,?19,"Telehealth VistA Clinics." "RTN","SDTMPEDT",51,0) W !! S DIC("A")="Select Clinic: ",(DIC,DIE)=44,DIC(0)="AEQMZ" D ^DIC G:"^"[X EX "RTN","SDTMPEDT",52,0) G:Y<0 PROVID "RTN","SDTMPEDT",53,0) S CLNDA=+Y "RTN","SDTMPEDT",54,0) L +^SC(CLNDA,0):5 I '$T W !!,$C(7),"Another user is editing this record. Try again later.",! D CR G EX "RTN","SDTMPEDT",55,0) S TXT="Providers associated with this clinic" "RTN","SDTMPEDT",56,0) W !!,$S($O(^SC(CLNDA,"PR",0)):" "_TXT_":",1:" No "_TXT_".") "RTN","SDTMPEDT",57,0) S PRIEN=0 F S PRIEN=$O(^SC(CLNDA,"PR","B",PRIEN)) Q:'PRIEN W !,?4,"- ",$$GET1^DIQ(200,PRIEN,.01) D "RTN","SDTMPEDT",58,0) . S SEQ=$O(^SC(CLNDA,"PR","B",PRIEN,0)) I $$GET1^DIQ(44.1,SEQ_","_CLNDA_",",.02,"I") W ?39,"<< Default >>" "RTN","SDTMPEDT",59,0) ; edit default provider and provider multiple fields "RTN","SDTMPEDT",60,0) W ! "RTN","SDTMPEDT",61,0) K DR S DR="16",DA=CLNDA,DIE=44 D ^DIE K DR "RTN","SDTMPEDT",62,0) I X D DPMAIL "RTN","SDTMPEDT",63,0) I $D(Y) Q "RTN","SDTMPEDT",64,0) W ! "RTN","SDTMPEDT",65,0) K DR S DR="2600",DR(2,44.1)=".01;.02",DA=CLNDA,DIE=44 D ^DIE K DR "RTN","SDTMPEDT",66,0) L -^SC(CLNDA,0) "RTN","SDTMPEDT",67,0) ; "RTN","SDTMPEDT",68,0) CR W !! K DIR S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Press to continue: " "RTN","SDTMPEDT",69,0) D ^DIR K DIR "RTN","SDTMPEDT",70,0) Q "RTN","SDTMPEDT",71,0) EX W @IOF K DA,DIC,DIE,DR,DIR "RTN","SDTMPEDT",72,0) Q "RTN","SDTMPEDT",73,0) DPMAIL ; default provider email "RTN","SDTMPEDT",74,0) N DPDA "RTN","SDTMPEDT",75,0) S DPDA=X "RTN","SDTMPEDT",76,0) L +^VA(200,DPDA):5 "RTN","SDTMPEDT",77,0) I '$T W !!,$C(7),"Another user is editing this provider record. Try again later.",! Q "RTN","SDTMPEDT",78,0) S DR=".151",DA=DPDA,DIE=200 D ^DIE K DR ;Prompt for default provider email - 780 "RTN","SDTMPEDT",79,0) L -^VA(200,DPDA) "RTN","SDTMPEDT",80,0) Q "RTN","SDTMPUT0") 0^2^B101063236^B69402969 "RTN","SDTMPUT0",1,0) SDTMPUT0 ;MS/SJA - TELEHEALTH SEARCH UTILITY ;Dec 17, 2020 "RTN","SDTMPUT0",2,0) ;;5.3;Scheduling;**773,779,812,817**;Aug 13, 1993;Build 7 "RTN","SDTMPUT0",3,0) ;Reference to ^DGCN(391.91 supported by IA #4943 "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;N:Patient ICN;L:List Stop Codes;S:Stop Code Lookup;SN:Station Number (Time Sensitive);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)=" N Patient ICN" "RTN","SDTMPUT0",18,0) S DIR("A",8)=" L List Telehealth Stop Codes" "RTN","SDTMPUT0",19,0) S DIR("A",9)=" S Telehealth Stop Code Lookup" "RTN","SDTMPUT0",20,0) S DIR("A",10)=" SN Station Number (Time Sensitive)" "RTN","SDTMPUT0",21,0) S DIR("A",11)="" "RTN","SDTMPUT0",22,0) S DIR("A")="Search Option or (Q)uit: " "RTN","SDTMPUT0",23,0) D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DIRUT) G END "RTN","SDTMPUT0",24,0) S OPT=Y W ! "RTN","SDTMPUT0",25,0) D @OPT "RTN","SDTMPUT0",26,0) G EN "RTN","SDTMPUT0",27,0) ; "RTN","SDTMPUT0",28,0) C ; Search by clinic "RTN","SDTMPUT0",29,0) K DIC,SDCL,SDNO,NOD0,PNODE,DIV,SDSL,MCD,INST,INSF,LTZ,CTRY,TZEX "RTN","SDTMPUT0",30,0) S DIC="^SC(",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))" "RTN","SDTMPUT0",31,0) S DIC("A")="Select CLINIC: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X I +Y'>0 G:+Y<0 C "RTN","SDTMPUT0",32,0) S SDCL=Y "RTN","SDTMPUT0",33,0) S SDNO="",NODE0=$G(^SC(+SDCL,0)),DIV=$P(NODE0,U,15) "RTN","SDTMPUT0",34,0) S SDSL=$G(^SC(+SDCL,"SL")),MCD=$G(^DG(40.8,DIV,0)),INST=$P(MCD,U,7) "RTN","SDTMPUT0",35,0) S INSF=$G(^DIC(4,INST,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3) "RTN","SDTMPUT0",36,0) W !!,SDASH,! "RTN","SDTMPUT0",37,0) W !,"Clinic",?18,": ",$TR(SDCL,"^","-") "RTN","SDTMPUT0",38,0) W !,"Default Provider",?18,": " I $P(NODE0,U,13) W $P(NODE0,U,13),"-",$P(^VA(200,$P(NODE0,U,13),0),U) "RTN","SDTMPUT0",39,0) W !,"Provider",?18,": " "RTN","SDTMPUT0",40,0) S II=0 F S II=$O(^SC(+SDCL,"PR",II)) Q:'II D "RTN","SDTMPUT0",41,0) . I $D(^SC(+SDCL,"PR",II,0)) S PNODE=^SC(+SDCL,"PR",II,0) W ?20,+PNODE,"-",$P(^VA(200,+PNODE,0),U),?50,$S($P(PNODE,U,2):" << Default >>",1:""),! "RTN","SDTMPUT0",42,0) W:'$O(^SC(+SDCL,"PR",0)) ! W "Medical Division",?18,": ",DIV,"-",$$GET1^DIQ(40.8,DIV,.01) "RTN","SDTMPUT0",43,0) W !,"Institution",?18,": ",INST,"-",$$GET1^DIQ(4,INST,.01) "RTN","SDTMPUT0",44,0) W !,"Station Number",?18,": ",$$GET1^DIQ(4,INST_",",99,"E") "RTN","SDTMPUT0",45,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",46,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",47,0) W !,"Country",?18,": ",CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01) "RTN","SDTMPUT0",48,0) W !,"Location Timezone",?18,": ",LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01) "RTN","SDTMPUT0",49,0) W !,"Timezone Exception",?18,": ",TZEX "RTN","SDTMPUT0",50,0) W !,"Overbooks per day",?18,": ",$P(SDSL,U,7) "RTN","SDTMPUT0",51,0) D ACT "RTN","SDTMPUT0",52,0) W !,SDASH,!! G C "RTN","SDTMPUT0",53,0) Q "RTN","SDTMPUT0",54,0) ; "RTN","SDTMPUT0",55,0) M ; Search by Medical Center Division "RTN","SDTMPUT0",56,0) K DIC,ZD,MCD,INST,INSF,LTZ,CTRY,TZEX "RTN","SDTMPUT0",57,0) S DIC="^DG(40.8,",DIC(0)="AEMQ" D ^DIC K DIC "RTN","SDTMPUT0",58,0) Q:"^"[X I +Y'>0 W !,$C(7),"Division not found. Please try again." G M "RTN","SDTMPUT0",59,0) S ZD=+Y "RTN","SDTMPUT0",60,0) S MCD=$G(^DG(40.8,ZD,0)),INST=$P(MCD,U,7) "RTN","SDTMPUT0",61,0) S INSF=$G(^DIC(4,INST,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3) "RTN","SDTMPUT0",62,0) W !!,SDASH,! "RTN","SDTMPUT0",63,0) W !,"Medical Division",?18,": ",ZD,"-",$$GET1^DIQ(40.8,ZD,.01) "RTN","SDTMPUT0",64,0) W !,"Facility Number",?18,": ",$P(MCD,U,2) "RTN","SDTMPUT0",65,0) W !,"Institution",?18,": ",INST,"-",$$GET1^DIQ(4,INST,.01) "RTN","SDTMPUT0",66,0) W !,SDASH,!! G M "RTN","SDTMPUT0",67,0) Q "RTN","SDTMPUT0",68,0) ; "RTN","SDTMPUT0",69,0) I ; search by Institution "RTN","SDTMPUT0",70,0) K DIC,FAC,NOD0,NODE1,NODE8,II,ARR,LTZ,CTRY,TZEX,NODE99 "RTN","SDTMPUT0",71,0) S DIC="^DIC(4,",DIC(0)="AEMNQ" D ^DIC K DIC Q:Y<1 0 "RTN","SDTMPUT0",72,0) Q:"^"[X I +Y'>0 W !,$C(7),"Institution not found. Please try again." G I "RTN","SDTMPUT0",73,0) S FAC=Y "RTN","SDTMPUT0",74,0) S NODE0=$G(^DIC(4,+Y,0)),NODE1=$G(^DIC(4,+Y,1)) "RTN","SDTMPUT0",75,0) S NODE8=$G(^DIC(4,+Y,8)),LTZ=$P(NODE8,U),CTRY=$P(NODE8,U,2),TZEX=$P(NODE8,U,3) "RTN","SDTMPUT0",76,0) S NODE99=$G(^DIC(4,+Y,99)) "RTN","SDTMPUT0",77,0) W !!,SDASH,! "RTN","SDTMPUT0",78,0) W !,"Name",?18,": ",$TR(FAC,"^","-") "RTN","SDTMPUT0",79,0) W !,"City",?18,": ",$P(NODE1,U,3) "RTN","SDTMPUT0",80,0) W !,"State",?18,": ",$P(NODE0,U,2),"-",$$GET1^DIQ(5,$P(NODE0,U,2),.01) "RTN","SDTMPUT0",81,0) W !,"District",?18,": ",$P(NODE0,U,3) "RTN","SDTMPUT0",82,0) W !,"VA region IEN",?18,": ",$P(NODE0,U,7) "RTN","SDTMPUT0",83,0) W !,"Location Timezone",?18,": ",LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01) "RTN","SDTMPUT0",84,0) W !,"Timezone Exception",?18,": ",TZEX "RTN","SDTMPUT0",85,0) W !,"Country",?18,": ",CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01) "RTN","SDTMPUT0",86,0) W !,"Station #",?18,": ",$P(NODE99,U) "RTN","SDTMPUT0",87,0) W !,"Facility DEA #:",?18,": ",$P($G(^DIC(4,+FAC,"DEA")),U) "RTN","SDTMPUT0",88,0) W !,"Facility Exp. date",?18,": ",$P($G(^DIC(4,+FAC,"DEA")),U,2) "RTN","SDTMPUT0",89,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",90,0) . W !,"Association",?18,": ",II_"-"_ARR(4.014,II_","_+FAC_",",.01,"E") "RTN","SDTMPUT0",91,0) . W ?40," Parent",": ",II_"-"_ARR(4.014,II_","_+FAC_",",1,"E") "RTN","SDTMPUT0",92,0) W !,SDASH,!! G I "RTN","SDTMPUT0",93,0) Q "RTN","SDTMPUT0",94,0) ; "RTN","SDTMPUT0",95,0) P ; search by patient "RTN","SDTMPUT0",96,0) K DIC,DFN,MPI,XX,ICNHA,VADM,SDDOD,SDDODN "RTN","SDTMPUT0",97,0) S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select Patient: " D ^DIC K DIC "RTN","SDTMPUT0",98,0) Q:"^"[X I +Y'>0 W !,$C(7),"Patient not found. Please try again." G P "RTN","SDTMPUT0",99,0) S DFN=+Y D 2^VADPT S MPI=$G(^DPT(DFN,"MPI")) "RTN","SDTMPUT0",100,0) S SDDOD=0,SDDOD=$O(^DGCN(391.91,"AKEY2",DFN,"USDOD",SDDOD)) "RTN","SDTMPUT0",101,0) I SDDOD S SDDODN=$P(^DGCN(391.91,SDDOD,2),U,2) "RTN","SDTMPUT0",102,0) W !,SDASH "RTN","SDTMPUT0",103,0) W !,"Number (IEN)",?18,": ",DFN "RTN","SDTMPUT0",104,0) W !,"Name",?18,": ",VADM(1) "RTN","SDTMPUT0",105,0) W !,"Sex",?18,": ",$P(VADM(5),U,2) "RTN","SDTMPUT0",106,0) W !,"Date of Birth",?18,": ",$P(VADM(3),U,2) "RTN","SDTMPUT0",107,0) W !,"SSN",?18,": ",$P(VADM(2),U,2) "RTN","SDTMPUT0",108,0) W !,"DOD Number",?18,": ",$G(SDDODN) "RTN","SDTMPUT0",109,0) W !,"Full ICN",?18,": ",$P(MPI,U,10) "RTN","SDTMPUT0",110,0) W !,"Integrated Control: ",$P(MPI,U) "RTN","SDTMPUT0",111,0) W !,"ICN Checksum",?18,": ",$P(MPI,U,2) "RTN","SDTMPUT0",112,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",113,0) W "Deceased Date",?18,": ",$P($P(VADM(6),U,2),"@"),! "RTN","SDTMPUT0",114,0) D SC "RTN","SDTMPUT0",115,0) W !,SDASH G P "RTN","SDTMPUT0",116,0) Q "RTN","SDTMPUT0",117,0) ; "RTN","SDTMPUT0",118,0) N ; search by ICN "RTN","SDTMPUT0",119,0) W !,"Select ICN: " R SDICN:DTIME "RTN","SDTMPUT0",120,0) I SDICN=""!(SDICN="^") D SDCLN Q "RTN","SDTMPUT0",121,0) I SDICN="?"!(SDICN="??") D SDHELP G N "RTN","SDTMPUT0",122,0) I '$D(^DPT("AFICN",SDICN)) W $C(7)," ??" G N "RTN","SDTMPUT0",123,0) S DFN="",SDCNT=0 F S DFN=$O(^DPT("AFICN",SDICN,DFN)) Q:DFN="" S SDCNT=SDCNT+1 D:SDCNT=1 SDINQ D:SDCNT>1 SDINQ,SDMSG "RTN","SDTMPUT0",124,0) W !,"Records Found: ",SDCNT,! "RTN","SDTMPUT0",125,0) G N "RTN","SDTMPUT0",126,0) Q "RTN","SDTMPUT0",127,0) ; "RTN","SDTMPUT0",128,0) S ; Telehealth stop code "RTN","SDTMPUT0",129,0) K DIC,CODE,STP1,STP2,F407,S407 "RTN","SDTMPUT0",130,0) S DIC="^SD(40.6,",DIC(0)="AEMNQ" D ^DIC K DIC "RTN","SDTMPUT0",131,0) Q:"^"[X I +Y'>0 W !,$C(7),"Telehealth Stop Code not found. Please try again." G S "RTN","SDTMPUT0",132,0) S CODE=$P(Y,U,2),STP1=$E(CODE,1,3),STP2=$E(CODE,4,6) "RTN","SDTMPUT0",133,0) S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0)) "RTN","SDTMPUT0",134,0) W !!,SDASH,! "RTN","SDTMPUT0",135,0) W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",136,0) I $G(STP2) W !,"Stop Code: ",STP2," > ",$P($G(^DIC(40.7,S407,0)),U) "RTN","SDTMPUT0",137,0) W !,SDASH,!! K X,Y G S "RTN","SDTMPUT0",138,0) Q "RTN","SDTMPUT0",139,0) ; "RTN","SDTMPUT0",140,0) L ; list Telehealth stop codes "RTN","SDTMPUT0",141,0) K DIC,CNT,II,STP1,STP2,F407,S407 "RTN","SDTMPUT0",142,0) S CNT=0 W !!,SDASH,! "RTN","SDTMPUT0",143,0) S II=0 F S II=$O(^SD(40.6,"B",II)) Q:'II D "RTN","SDTMPUT0",144,0) . S CNT=CNT+1,STP1=$E(II,1,3),STP2=$E(II,4,6) "RTN","SDTMPUT0",145,0) . S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0)) "RTN","SDTMPUT0",146,0) . I STP2 W !,"Stop Code: ",STP1_STP2 D Q "RTN","SDTMPUT0",147,0) . . W !,?11,STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",148,0) . . W !,?11,STP2," > ",$P($G(^DIC(40.7,S407,0)),U) "RTN","SDTMPUT0",149,0) . W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",150,0) W !,SDASH "RTN","SDTMPUT0",151,0) W !,"Total number of Telehealth Stop code: ",CNT,!! "RTN","SDTMPUT0",152,0) S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT0",153,0) Q "RTN","SDTMPUT0",154,0) ; "RTN","SDTMPUT0",155,0) SN ; Search by Station Number "RTN","SDTMPUT0",156,0) K DIC,NODE0,II K ^TMP($J) "RTN","SDTMPUT0",157,0) N1 S DIC="^VA(389.9,",DIC(0)="AEMQ" D ^DIC K DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Another one:" G N1 "RTN","SDTMPUT0",158,0) I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q "RTN","SDTMPUT0",159,0) W !!,SDASH "RTN","SDTMPUT0",160,0) F II=0:0 S II=$O(^TMP($J,II)) Q:'II W ! D "RTN","SDTMPUT0",161,0) . S NODE0=$G(^VA(389.9,II,0)) "RTN","SDTMPUT0",162,0) . W !,"Number: ",II,?35,"Reference Number: ",$P(NODE0,U) "RTN","SDTMPUT0",163,0) . W !,?2,"Effective Date: " I $P(NODE0,U,2) W $$FMTE^XLFDT($P(NODE0,U,2),1) "RTN","SDTMPUT0",164,0) . W ?35,"Medical Center Division: " I $P(NODE0,U,3) W $P(NODE0,U,3)_"-",$$GET1^DIQ(40.8,$P(NODE0,U,3),.01) "RTN","SDTMPUT0",165,0) . W !,?2,"Station Number: ",$P(NODE0,U,4),?35,"Inactive: ",$S($P(NODE0,U,6):"Yes",1:"No") "RTN","SDTMPUT0",166,0) . W !,?2,"Is Primary Division: ",$S($P(NODE0,U,5):"Yes",1:"No") "RTN","SDTMPUT0",167,0) . W ! "RTN","SDTMPUT0",168,0) K ^TMP($J) "RTN","SDTMPUT0",169,0) W !!,SDASH,! G SN "RTN","SDTMPUT0",170,0) Q "RTN","SDTMPUT0",171,0) ; "RTN","SDTMPUT0",172,0) ICN ; full ICN history "RTN","SDTMPUT0",173,0) K ICNHA "RTN","SDTMPUT0",174,0) I '$D(^DPT(DFN,"MPIFICNHIS")) S ICNHA(1)="NO ICN HISTORY" Q "RTN","SDTMPUT0",175,0) S (SIEN,CNT)=0 "RTN","SDTMPUT0",176,0) F S SIEN=$O(^DPT(DFN,"MPIFICNHIS",SIEN)) Q:'SIEN D "RTN","SDTMPUT0",177,0) . S FICN=$P($G(^DPT(DFN,"MPIFICNHIS",SIEN,0)),"^") I FICN'="" S CNT=CNT+1,ICNHA(CNT)=FICN "RTN","SDTMPUT0",178,0) I CNT=0 S ICNHA(1)="NO ICN HISTORY" Q "RTN","SDTMPUT0",179,0) S ICNHA=CNT "RTN","SDTMPUT0",180,0) Q "RTN","SDTMPUT0",181,0) ; "RTN","SDTMPUT0",182,0) ACT ; inactive clinic "RTN","SDTMPUT0",183,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",184,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",185,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",186,0) Q "RTN","SDTMPUT0",187,0) ; "RTN","SDTMPUT0",188,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",189,0) K LTZ,SDASH,STP1,STP2,TZEX,SDSL,SDRE,SDIN,SDNO,OPT,VADM,XX,ZD "RTN","SDTMPUT0",190,0) Q "RTN","SDTMPUT0",191,0) ; "RTN","SDTMPUT0",192,0) SC ;SERVICE CONNECTED MESSAGE/IOFO - BAY PINES/TEH "RTN","SDTMPUT0",193,0) N VAEL "RTN","SDTMPUT0",194,0) I +$P($G(^DPT(DFN,.3)),U,2)>49 D "RTN","SDTMPUT0",195,0) . W !,?7,"********** THIS PATIENT IS 50% OR GREATER SERVICE-CONNECTED **********",! "RTN","SDTMPUT0",196,0) D 2^VADPT "RTN","SDTMPUT0",197,0) W !,"PATIENT'S SERVICE CONNECTION AND RATED DISABILITIES:" "RTN","SDTMPUT0",198,0) I $$GET1^DIQ(2,DFN_",",.301,"E")="YES"&($P(VAEL(3),"^",2)'="") D "RTN","SDTMPUT0",199,0) . W !,"SC Percent: "_$P(VAEL(3),"^",2)_"%" "RTN","SDTMPUT0",200,0) I $$GET1^DIQ(2,DFN_",",.301,"E")="NO"&($P(VAEL(3),"^",2)="") D "RTN","SDTMPUT0",201,0) . W !,"Service Connected: No" "RTN","SDTMPUT0",202,0) ;Rated Disabilities "RTN","SDTMPUT0",203,0) N SDSER,SDRAT,SDREC,NN,NUM "RTN","SDTMPUT0",204,0) S (NN,NUM)=0 "RTN","SDTMPUT0",205,0) F S NN=$O(^DPT(DFN,.372,NN)) Q:'NN D "RTN","SDTMPUT0",206,0) . S SDREC=$G(^DPT(DFN,.372,NN,0)) I SDREC'="" D "RTN","SDTMPUT0",207,0) . . S SDRAT="" S NUM=$P($G(SDREC),"^",1) I NUM>0 S SDRAT=$$GET1^DIQ(31,NUM_",",.01) "RTN","SDTMPUT0",208,0) . . S SDSER="" S SDSER=$S($P(SDREC,"^",3)="1":"SC",1:"NSC") "RTN","SDTMPUT0",209,0) . . W !," "_SDRAT_" ("_SDSER_" - "_$P(SDREC,"^",2)_"%)" "RTN","SDTMPUT0",210,0) ; "RTN","SDTMPUT0",211,0) W !,"Primary Eligibility Code: "_$P(VAEL(1),"^",2) "RTN","SDTMPUT0",212,0) I $P($G(^DPT(DFN,.372,0)),"^",4)<1 W !,"No Service Connected Disabilities Listed" "RTN","SDTMPUT0",213,0) Q "RTN","SDTMPUT0",214,0) ; "RTN","SDTMPUT0",215,0) SDINQ ;Print inquiry "RTN","SDTMPUT0",216,0) D 2^VADPT S MPI=$G(^DPT(DFN,"MPI")) "RTN","SDTMPUT0",217,0) S SDDOD=0,SDDOD=$O(^DGCN(391.91,"AKEY2",DFN,"USDOD",SDDOD)) "RTN","SDTMPUT0",218,0) I SDDOD S SDDODN=$P(^DGCN(391.91,SDDOD,2),U,2) "RTN","SDTMPUT0",219,0) W !,SDASH "RTN","SDTMPUT0",220,0) W !,"Full ICN",?18,": ",$P(MPI,U,10) "RTN","SDTMPUT0",221,0) W !,"Number (IEN)",?18,": ",DFN "RTN","SDTMPUT0",222,0) W !,"Name",?18,": ",VADM(1) "RTN","SDTMPUT0",223,0) W !,"Sex",?18,": ",$P(VADM(5),U,2) "RTN","SDTMPUT0",224,0) W !,"Date of Birth",?18,": ",$P(VADM(3),U,2) "RTN","SDTMPUT0",225,0) W !,"SSN",?18,": ",$P(VADM(2),U,2) "RTN","SDTMPUT0",226,0) W !,"DOD Number",?18,": ",$G(SDDODN) "RTN","SDTMPUT0",227,0) W !,"Integrated Control: ",$P(MPI,U) "RTN","SDTMPUT0",228,0) W !,"ICN Checksum",?18,": ",$P(MPI,U,2) "RTN","SDTMPUT0",229,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",230,0) W "Deceased Date",?18,": ",$P($P(VADM(6),U,2),"@"),! "RTN","SDTMPUT0",231,0) D SC "RTN","SDTMPUT0",232,0) W !,SDASH,! "RTN","SDTMPUT0",233,0) Q "RTN","SDTMPUT0",234,0) ; "RTN","SDTMPUT0",235,0) SDMSG ;Print warning for multiple ICN "RTN","SDTMPUT0",236,0) W !,$C(7) "RTN","SDTMPUT0",237,0) W "More than one Patient ICN exists in this VistA System, please contact your",! "RTN","SDTMPUT0",238,0) W "local Health Administration Services. If this is related to an INTRAfacility",! "RTN","SDTMPUT0",239,0) W "action, enter a Service Now ticket with your local HAS Office. If this is",! "RTN","SDTMPUT0",240,0) W "related to an INTERfacility action, enter an IAM Toolkit Request at",! "RTN","SDTMPUT0",241,0) W "http://vaww.vhadataportal.domain.ext/PolicyAdmin/HealthcareIdentityManagement.aspx",! "RTN","SDTMPUT0",242,0) Q "RTN","SDTMPUT0",243,0) ; "RTN","SDTMPUT0",244,0) SDCLN ;Clean up variables "RTN","SDTMPUT0",245,0) K SDCNT,DFN,ICNHA,FICN,MPI,SDICN,VA,VADM,XX,SDDOD,SDDODN "RTN","SDTMPUT0",246,0) Q "RTN","SDTMPUT0",247,0) ; "RTN","SDTMPUT0",248,0) SDHELP ;Help text "RTN","SDTMPUT0",249,0) W !," Enter the local or national Integration Control Number (ICN)",! "RTN","SDTMPUT0",250,0) W " assigned to the patient.",! "RTN","SDTMPUT0",251,0) Q "RTN","SDTMPUT2") 0^4^B46095434^n/a "RTN","SDTMPUT2",1,0) SDTMPUT2 ;MS/SJA - VISTA-BULK DEFAULT PROVIDER UPDATE ;May 15, 2022 "RTN","SDTMPUT2",2,0) ;;5.3;Scheduling;**817**;Aug 13, 1993;Build 7 "RTN","SDTMPUT2",3,0) ; "RTN","SDTMPUT2",4,0) ; "RTN","SDTMPUT2",5,0) N AA,ACT,ALL,CLN,CNT,LN,DIV,III,NUM,LOC,RESTCD,SC,STCODE,STOP,SDASH,SDOUT,STIEN,VAL,SEL "RTN","SDTMPUT2",6,0) N TOT,TOTAL,VAUTD,CLIEN,PRIEN,XX "RTN","SDTMPUT2",7,0) EN ; "RTN","SDTMPUT2",8,0) K ^TMP($J) "RTN","SDTMPUT2",9,0) S $P(SDASH,"=",80)="",(SEL,ACT,DIV)="",(ALL,SDOUT)=0 "RTN","SDTMPUT2",10,0) W @IOF W !,?20,"Bulk update for Default Provider field",! "RTN","SDTMPUT2",11,0) D ASK Q:SDOUT "RTN","SDTMPUT2",12,0) S:$G(VAUTD)=1 DIV="ALL" "RTN","SDTMPUT2",13,0) W ! D @SEL "RTN","SDTMPUT2",14,0) G EN "RTN","SDTMPUT2",15,0) ; "RTN","SDTMPUT2",16,0) C ; clinic "RTN","SDTMPUT2",17,0) K ^TMP($J) S (TOTAL,TOT)=0 "RTN","SDTMPUT2",18,0) K DIC,DTOUT,DUOUT S DIC="^SC(",DIC(0)="AEQM",DIC("A")="Select Clinic: " "RTN","SDTMPUT2",19,0) C1 D ^DIC I Y>0 S ^TMP($J,"CL",+Y)="",DIC("A")="Another one:" G C1 "RTN","SDTMPUT2",20,0) I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,"CL",0))) Q "RTN","SDTMPUT2",21,0) F III=0:0 S III=$O(^TMP($J,"CL",III)) Q:'III D "RTN","SDTMPUT2",22,0) . W:TOTAL=0 !,SDASH,! "RTN","SDTMPUT2",23,0) . D PRC(III) "RTN","SDTMPUT2",24,0) W !! "RTN","SDTMPUT2",25,0) W !,"Total number of clinics updated ",TOT," out of ",TOTAL "RTN","SDTMPUT2",26,0) W !! S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT2",27,0) Q "RTN","SDTMPUT2",28,0) ; "RTN","SDTMPUT2",29,0) S ; stop codes "RTN","SDTMPUT2",30,0) K ^TMP($J) S (LN,TOTAL,TOT)=0 "RTN","SDTMPUT2",31,0) K DIC,DTOUT,DUOUT S DIC="^SD(40.6,",DIC(0)="AEMQ",DIC("A")="Select Telehealth Stop Code: " "RTN","SDTMPUT2",32,0) S1 D ^DIC I Y>0 S ^TMP($J,"ST",+Y)="",DIC("A")="Select another Telehealth Stop Code: " G S1 "RTN","SDTMPUT2",33,0) I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,"ST",0))) Q "RTN","SDTMPUT2",34,0) W ! "RTN","SDTMPUT2",35,0) F STIEN=0:0 S STIEN=$O(^TMP($J,"ST",STIEN)) Q:'STIEN S CLN=$$ST(STIEN) "RTN","SDTMPUT2",36,0) F III=0:0 S III=$O(^TMP($J,"CL",III)) Q:'III S STOP=$G(^(III)) D "RTN","SDTMPUT2",37,0) . W:TOTAL=0 !,SDASH,! "RTN","SDTMPUT2",38,0) . S LN=LN+1 W:'(LN#50) "." D PRC(III,STOP) "RTN","SDTMPUT2",39,0) W !! "RTN","SDTMPUT2",40,0) W !,"Total number of clinics updated ",TOT," out of ",TOTAL "RTN","SDTMPUT2",41,0) W !! S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT2",42,0) Q "RTN","SDTMPUT2",43,0) ; "RTN","SDTMPUT2",44,0) P ; provider selection "RTN","SDTMPUT2",45,0) K ^TMP($J) S (TOTAL,TOT)=0 "RTN","SDTMPUT2",46,0) S DIC=200,DIC("A")="Select Provider: ",DIC(0)="AEMQ",DIC("S")="I $$SCREEN^SDUTL2(Y,DT)" "RTN","SDTMPUT2",47,0) P1 D ^DIC I Y>0 S ^TMP($J,"PR",+Y)="",DIC("A")="Another one:" G P1 "RTN","SDTMPUT2",48,0) I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,"PR",0))) Q "RTN","SDTMPUT2",49,0) F III=0:0 S III=$O(^TMP($J,"PR",III)) Q:'III D "RTN","SDTMPUT2",50,0) . W:TOTAL=0 !!,SDASH,! "RTN","SDTMPUT2",51,0) . D PRU(III) "RTN","SDTMPUT2",52,0) W !! "RTN","SDTMPUT2",53,0) W !,"Total number of clinics updated ",TOT," out of ",TOTAL "RTN","SDTMPUT2",54,0) W !! S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT2",55,0) Q "RTN","SDTMPUT2",56,0) ; "RTN","SDTMPUT2",57,0) ST(STIEN) ; stop codes search "RTN","SDTMPUT2",58,0) N FLAG,FLG1,FLG2,CODE,P1,P2,P407F,P407S,II,NODE0,CLSTP1,CLSTP2,XX "RTN","SDTMPUT2",59,0) S (FLAG,P407F,P407S,P1,P2)=0 "RTN","SDTMPUT2",60,0) S CODE=$G(^SD(40.6,STIEN,0)),P1=$E(CODE,1,3),P2=$E(CODE,4,6) "RTN","SDTMPUT2",61,0) S P407F=$O(^DIC(40.7,"C",P1,0)) S:P2 P407S=$O(^DIC(40.7,"C",P2,0)) "RTN","SDTMPUT2",62,0) S II=0 "RTN","SDTMPUT2",63,0) F S II=$O(^SC(II)) Q:'II S FLAG=0 D "RTN","SDTMPUT2",64,0) . S NODE0=$G(^SC(II,0)),CLSTP1=$P(NODE0,U,7),CLSTP2=$P(NODE0,U,18) "RTN","SDTMPUT2",65,0) . I (SC="P"&($G(CLSTP1)="")!(SC="S"&$G(CLSTP2)="")) Q "RTN","SDTMPUT2",66,0) . I SC="P" I $G(P407F)=$G(CLSTP1)!(CLSTP1=$G(P407S)) S FLAG=1 "RTN","SDTMPUT2",67,0) . I SC="S" I $G(P407F)=$G(CLSTP2)!(CLSTP2=$G(P407S)) S FLAG=1 "RTN","SDTMPUT2",68,0) . I 'FLAG Q "RTN","SDTMPUT2",69,0) . S XX=$$ACTIVE(II) "RTN","SDTMPUT2",70,0) . I 'XX&(ACT="A") Q "RTN","SDTMPUT2",71,0) . S ^TMP($J,"CL",II)=$S(CLSTP1:$$GET1^DIQ(40.7,CLSTP1,1),1:"")_U_$S(CLSTP2:$$GET1^DIQ(40.7,CLSTP2,1),1:"") "RTN","SDTMPUT2",72,0) Q 1 "RTN","SDTMPUT2",73,0) ; "RTN","SDTMPUT2",74,0) EXIT ; kill and exit "RTN","SDTMPUT2",75,0) K DTOUT,DUOUT,DTOT "RTN","SDTMPUT2",76,0) K ^TMP($J) "RTN","SDTMPUT2",77,0) Q "RTN","SDTMPUT2",78,0) ; "RTN","SDTMPUT2",79,0) ASK ; selection options "RTN","SDTMPUT2",80,0) W ! K DIR,Y S DIR(0)="SA^C:Clinic;S:Stop Code;P:Provider;Q:Quit" "RTN","SDTMPUT2",81,0) S DIR("A")="Select (C)linic, (S)top Code, (P)rovider, or (Q)uit: " "RTN","SDTMPUT2",82,0) S DIR("B")="C" "RTN","SDTMPUT2",83,0) D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DUOUT) S SDOUT=1 Q "RTN","SDTMPUT2",84,0) S ACT="A" W ! "RTN","SDTMPUT2",85,0) S SEL=Y W ! I SEL'="S" Q "RTN","SDTMPUT2",86,0) S DIR(0)="SA^P:Primary Stop Code;S:Secondary Stop Code" "RTN","SDTMPUT2",87,0) S DIR("A")="(P)rimary Stop Code, (S)econdary Stop Code: " "RTN","SDTMPUT2",88,0) S DIR("B")="P" "RTN","SDTMPUT2",89,0) D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q "RTN","SDTMPUT2",90,0) S SC=Y "RTN","SDTMPUT2",91,0) Q "RTN","SDTMPUT2",92,0) ; "RTN","SDTMPUT2",93,0) ACTIVE(LOC) ;determine if clinic is active "RTN","SDTMPUT2",94,0) ; Output X:1=ACTIVE, "RTN","SDTMPUT2",95,0) ; X:0=INACTIVE "RTN","SDTMPUT2",96,0) N NODE,I1,I2,X "RTN","SDTMPUT2",97,0) S X=0 "RTN","SDTMPUT2",98,0) S NODE=$G(^SC(LOC,"I")) Q:NODE="" 1 "RTN","SDTMPUT2",99,0) S I1=$P(NODE,U,1) ;inactive date/time "RTN","SDTMPUT2",100,0) S I2=$P(NODE,U,2) ;reactive date/time "RTN","SDTMPUT2",101,0) I (I1="") S X=1 Q X "RTN","SDTMPUT2",102,0) I ((I1'="")&(I1>DT))!((I2'="")&(I2'>DT)) S X=1 Q X "RTN","SDTMPUT2",103,0) Q X "RTN","SDTMPUT2",104,0) ; "RTN","SDTMPUT2",105,0) PRU(PRIEN) ; call for provider call "RTN","SDTMPUT2",106,0) S (CLN,CNT,TOTAL)=0,VAL="" F S CLN=$O(^SC("AVADPR",PRIEN,CLN)) Q:'CLN S TOTAL=TOTAL+1 D "RTN","SDTMPUT2",107,0) . S (CNT,NUM)=0 F S NUM=$O(^SC(CLN,"PR",NUM)) Q:'NUM S CNT=CNT+1,AA=$G(^(NUM,0)) S:$P(AA,U,2) VAL=$P(AA,U)_U_CLN "RTN","SDTMPUT2",108,0) . I $G(CLN) S STOP=$$SC(CLN) "RTN","SDTMPUT2",109,0) . I $$GET1^DIQ(44,CLN,16,"I") W !,CLN,?12,$$GET1^DIQ(44,$P(VAL,U,2),.01),STOP W !,?8,"--- No action taken, default provider is already set.",! Q "RTN","SDTMPUT2",110,0) . I CNT>1 W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,$P(VAL,U,2),.01),STOP W !,?8,"--- No action taken, multiple providers assigned.",! Q "RTN","SDTMPUT2",111,0) . I CNT=1,'$$GET1^DIQ(44,CLN,16,"I"),+VAL D "RTN","SDTMPUT2",112,0) . . K DR S DR="16////"_$P(VAL,U),DA=CLN,DIE=44 D ^DIE K DA,DIE,DR "RTN","SDTMPUT2",113,0) . . W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,CLN,.01),STOP W !,?8,">>> Default Provider set to: ",$$GET1^DIQ(200,+VAL,.01),! S TOT=TOT+1 "RTN","SDTMPUT2",114,0) . I CNT=1,('$$GET1^DIQ(44,CLN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLN,.01),STOP W !,?8,"--- No action taken, no default provider found.",! "RTN","SDTMPUT2",115,0) . I CNT=0,('$$GET1^DIQ(44,CLN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLN,.01),STOP W !,?8,"--- No action taken, no Providers found.",! "RTN","SDTMPUT2",116,0) Q "RTN","SDTMPUT2",117,0) ; "RTN","SDTMPUT2",118,0) PRC(CLIEN,STCODE) ; call for clinic search "RTN","SDTMPUT2",119,0) S RESTCD=",136,444,446,490,644,646,690,694,699,723,901,",TOTAL=TOTAL+1 "RTN","SDTMPUT2",120,0) S (CNT,NUM)=0,STOP="",VAL="" F S NUM=$O(^SC(CLIEN,"PR",NUM)) Q:'NUM S CNT=CNT+1,AA=$G(^(NUM,0)) S:$P(AA,U,2) VAL=$P(AA,U)_U_CLIEN "RTN","SDTMPUT2",121,0) I $G(CLIEN) S STOP=$$SC(CLIEN) "RTN","SDTMPUT2",122,0) I SEL="S" S II=$S(SC="P":1,1:2) I $P(STCODE,U,II),RESTCD[(","_$P(STCODE,U,II)_",") D Q "RTN","SDTMPUT2",123,0) . W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),$$SC(CLIEN) "RTN","SDTMPUT2",124,0) . W !,?8,"--- Telehealth Patient Site Stop Codes are not allowed for Bulk",!,?12,"Default Provider Update" "RTN","SDTMPUT2",125,0) I $$GET1^DIQ(44,CLIEN,16,"I") W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,"--- No action taken, default provider is already set.",! Q "RTN","SDTMPUT2",126,0) I CNT>1,$G(VAL) W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,$P(VAL,U,2),.01),$$SC($P(VAL,U,2)) W !,?8,"--- No action taken, multiple providers assigned.",! Q "RTN","SDTMPUT2",127,0) I CNT=1,$G(VAL),'$$GET1^DIQ(44,CLIEN,16,"I"),+VAL D "RTN","SDTMPUT2",128,0) . K DR S DR="16////"_$P(VAL,U),DA=CLIEN,DIE=44 D ^DIE K DA,DIE,DR "RTN","SDTMPUT2",129,0) . W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,">>> Default Provider is set to: ",$$GET1^DIQ(200,+VAL,.01),! S TOT=TOT+1 "RTN","SDTMPUT2",130,0) I CNT=1,('$$GET1^DIQ(44,CLIEN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,"--- No action taken, no default provider found.",! "RTN","SDTMPUT2",131,0) I CNT=0,('$$GET1^DIQ(44,CLIEN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,"--- No action taken, no Providers found.",! "RTN","SDTMPUT2",132,0) Q "RTN","SDTMPUT2",133,0) ; "RTN","SDTMPUT2",134,0) SC(CLIEN) ; call to return clinic stop codes "RTN","SDTMPUT2",135,0) N NODE0,RESULT "RTN","SDTMPUT2",136,0) S NODE0=$G(^SC(CLIEN,0)) "RTN","SDTMPUT2",137,0) S RESULT=" ("_$$GET1^DIQ(40.7,$P(NODE0,U,7),1)_"/"_$$GET1^DIQ(40.7,$P(NODE0,U,18),1)_")" "RTN","SDTMPUT2",138,0) Q RESULT "RTN","SDTMPUT2",139,0) ; "VER") 8.0^22.2 "BLD",11982,6) ^678 **END** **END**