EMERGENCY Released SD*5.3*737 SEQ #599 Extracted from mail message **KIDS**:SD*5.3*737^ **INSTALL NAME** SD*5.3*737 "BLD",11671,0) SD*5.3*737^SCHEDULING^0^3200122^y "BLD",11671,1,0) ^^7^7^3191112^^ "BLD",11671,1,1,0) Pending appointments list in VSE does not show CHECKED IN status if "BLD",11671,1,2,0) appointment checked in using VPS Kiosks. This occurs because VPS code "BLD",11671,1,3,0) only updates the appointment in the Location file (#44). It does not "BLD",11671,1,4,0) call the VSE check-in API. "BLD",11671,1,5,0) "BLD",11671,1,6,0) Code change made to SDEC50 to look in Location file for check-in "BLD",11671,1,7,0) date/time if not found in the Appointment file (#409.84). "BLD",11671,4,0) ^9.64PA^^ "BLD",11671,6) 4^ "BLD",11671,6.3) 13 "BLD",11671,"ABPKG") n "BLD",11671,"KRN",0) ^9.67PA^779.2^20 "BLD",11671,"KRN",.4,0) .4 "BLD",11671,"KRN",.401,0) .401 "BLD",11671,"KRN",.402,0) .402 "BLD",11671,"KRN",.403,0) .403 "BLD",11671,"KRN",.5,0) .5 "BLD",11671,"KRN",.84,0) .84 "BLD",11671,"KRN",3.6,0) 3.6 "BLD",11671,"KRN",3.8,0) 3.8 "BLD",11671,"KRN",9.2,0) 9.2 "BLD",11671,"KRN",9.8,0) 9.8 "BLD",11671,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",11671,"KRN",9.8,"NM",1,0) SDEC50^^0^B169535547 "BLD",11671,"KRN",9.8,"NM",2,0) SDECSTSR^^0^B57183153 "BLD",11671,"KRN",9.8,"NM",3,0) SDECSTSQ^^0^B35405698 "BLD",11671,"KRN",9.8,"NM",4,0) SDCNSLT^^0^B47180500 "BLD",11671,"KRN",9.8,"NM","B","SDCNSLT",4) "BLD",11671,"KRN",9.8,"NM","B","SDEC50",1) "BLD",11671,"KRN",9.8,"NM","B","SDECSTSQ",3) "BLD",11671,"KRN",9.8,"NM","B","SDECSTSR",2) "BLD",11671,"KRN",19,0) 19 "BLD",11671,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",11671,"KRN",19,"NM",1,0) SDEC APPT-ENC STATUS LIST^^0 "BLD",11671,"KRN",19,"NM",2,0) SDSUP^^2 "BLD",11671,"KRN",19,"NM","B","SDEC APPT-ENC STATUS LIST",1) "BLD",11671,"KRN",19,"NM","B","SDSUP",2) "BLD",11671,"KRN",19.1,0) 19.1 "BLD",11671,"KRN",101,0) 101 "BLD",11671,"KRN",409.61,0) 409.61 "BLD",11671,"KRN",771,0) 771 "BLD",11671,"KRN",779.2,0) 779.2 "BLD",11671,"KRN",870,0) 870 "BLD",11671,"KRN",8989.51,0) 8989.51 "BLD",11671,"KRN",8989.52,0) 8989.52 "BLD",11671,"KRN",8994,0) 8994 "BLD",11671,"KRN","B",.4,.4) "BLD",11671,"KRN","B",.401,.401) "BLD",11671,"KRN","B",.402,.402) "BLD",11671,"KRN","B",.403,.403) "BLD",11671,"KRN","B",.5,.5) "BLD",11671,"KRN","B",.84,.84) "BLD",11671,"KRN","B",3.6,3.6) "BLD",11671,"KRN","B",3.8,3.8) "BLD",11671,"KRN","B",9.2,9.2) "BLD",11671,"KRN","B",9.8,9.8) "BLD",11671,"KRN","B",19,19) "BLD",11671,"KRN","B",19.1,19.1) "BLD",11671,"KRN","B",101,101) "BLD",11671,"KRN","B",409.61,409.61) "BLD",11671,"KRN","B",771,771) "BLD",11671,"KRN","B",779.2,779.2) "BLD",11671,"KRN","B",870,870) "BLD",11671,"KRN","B",8989.51,8989.51) "BLD",11671,"KRN","B",8989.52,8989.52) "BLD",11671,"KRN","B",8994,8994) "BLD",11671,"QDEF") ^^^^NO^^^^YES^^NO "BLD",11671,"QUES",0) ^9.62^^ "BLD",11671,"REQB",0) ^9.611^2^2 "BLD",11671,"REQB",1,0) SD*5.3*723^1 "BLD",11671,"REQB",2,0) SD*5.3*686^1 "BLD",11671,"REQB","B","SD*5.3*686",2) "BLD",11671,"REQB","B","SD*5.3*723",1) "KRN",19,247,-1) 2^2 "KRN",19,247,0) SDSUP^Supervisor Menu^^M^66481^^^^^^^16 "KRN",19,247,10,0) ^19.01IP^38^38 "KRN",19,247,10,38,0) 14503 "KRN",19,247,10,38,"^") SDEC APPT-ENC STATUS LIST "KRN",19,247,"U") SUPERVISOR MENU "KRN",19,14503,-1) 0^1 "KRN",19,14503,0) SDEC APPT-ENC STATUS LIST^List Appointments and Encounters by status^^R^^^^^^^^SCHEDULING "KRN",19,14503,1,0) ^19.06^2^2^3191113^^ "KRN",19,14503,1,1,0) This option lists all patient appointment-encounter-appointment file "KRN",19,14503,1,2,0) triples that match user selected status values for each file. "KRN",19,14503,25) FIND^SDECSTSQ "KRN",19,14503,"U") LIST APPOINTMENTS AND ENCOUNTE "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 "PKG",16,22,1,"PAH",1,0) 737^3200122^1615 "PKG",16,22,1,"PAH",1,1,0) ^^7^7^3200122 "PKG",16,22,1,"PAH",1,1,1,0) Pending appointments list in VSE does not show CHECKED IN status if "PKG",16,22,1,"PAH",1,1,2,0) appointment checked in using VPS Kiosks. This occurs because VPS code "PKG",16,22,1,"PAH",1,1,3,0) only updates the appointment in the Location file (#44). It does not "PKG",16,22,1,"PAH",1,1,4,0) call the VSE check-in API. "PKG",16,22,1,"PAH",1,1,5,0) "PKG",16,22,1,"PAH",1,1,6,0) Code change made to SDEC50 to look in Location file for check-in "PKG",16,22,1,"PAH",1,1,7,0) date/time if not found in the Appointment file (#409.84). "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 4 "RTN","SDCNSLT") 0^4^B47180500^B45406127 "RTN","SDCNSLT",1,0) SDCNSLT ;ALB/HAG - LINK APPOINTMENTS TO CONSULTS ;JAN 15, 2016 "RTN","SDCNSLT",2,0) ;;5.3;Scheduling;**478,496,630,627,686,737**;Aug 13, 1993;Build 13 "RTN","SDCNSLT",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","SDCNSLT",4,0) A ;===GET ACTIVE AND PENDING CONSULT "RTN","SDCNSLT",5,0) N A,ND,CNT,CONS,CPRSTAT,DTENTR,DTIN,DTLMT,DTR,NOS,NOSHOW,SENDER,SERVICE,SRV,P8,PROC,PT,PTNM,STATUS "RTN","SDCNSLT",6,0) K TMP S NOSHOW="no-show",CNT=0,$P(DSH,"-",IOM-1)="",PT=DFN,X1=DT,X2=-365 D C^%DTC S DTLMT=X "RTN","SDCNSLT",7,0) S A=":" F S A=$O(^GMR(123,"F",PT,A),-1) Q:'+A S ND=$G(^GMR(123,A,0)) Q:ND="" S PROC=$P($G(^GMR(123,A,1.11)),U),DTENTR=$P(ND,U) I DTENTR>DTLMT S CPRSTAT=$P(ND,U,12) D:CPRSTAT=5!(CPRSTAT=6)!(CPRSTAT=8)!(CPRSTAT=13) "RTN","SDCNSLT",8,0) .Q:$D(^XTMP("SDECLKC-"_A)) ;do not display consult if locked by VS GUI ;alb/sat 627 "RTN","SDCNSLT",9,0) .I STPCOD'="" S SRV=$P(ND,U,5) Q:'+SRV I $D(^GMR(123.5,"AB1",STPCOD,SRV)) S PTIEN=$P(ND,U,2) D "RTN","SDCNSLT",10,0) ..I CPRSTAT=8 S SHOW=0 Q:$D(^SC("AWAS1",A)) S NOS=$O(^GMR(123,A,40,":"),-1) Q:'+NOS S X2=$P($G(^GMR(123,A,40,NOS,0)),U),X1=DT D ^%DTC Q:X'=""&(X>180) D SCHED(PTIEN,STPCOD,.SHOW) Q:'SHOW "RTN","SDCNSLT",11,0) ..;CPRSTAT 13 is a cancel "RTN","SDCNSLT",12,0) ..I CPRSTAT=13 S NOS=$O(^GMR(123,A,40,":"),-1) Q:'+NOS S NOS=$O(^GMR(123,A,40,NOS),-1) Q:'+NOS S X2=$P($G(^GMR(123,A,40,NOS,0)),U),X1=DT D ^%DTC Q:X'=""&(X>180) S COMMENT=$G(^GMR(123,A,40,NOS,1,1,0)) Q:COMMENT'[NOSHOW "RTN","SDCNSLT",13,0) ..S:+PTIEN PTNM=$P(^DPT(PTIEN,0),U) S SERVICE=$P(^GMR(123.5,SRV,0),U),STATUS=$P(^ORD(100.01,CPRSTAT,0),U),SENDER=$P(ND,U,14) S:+SENDER SENDER=$P(^VA(200,SENDER,0),U) "RTN","SDCNSLT",14,0) ..S Y=DTENTR D DD^%DT S DTIN=Y,DTR=$E(DTENTR,4,5)_"/"_$E(DTENTR,6,7)_"/"_$E(DTENTR,2,3)_"@"_$P(Y,"@",2) "RTN","SDCNSLT",15,0) ..S CNT=CNT+1,TMP(CNT)=PTIEN_U_SERVICE_U_SENDER_U_STATUS_U_DTR_U_A_U_DTIN_U_$P(ND,U,17)_U_PROC "RTN","SDCNSLT",16,0) Q:'$D(TMP) "RTN","SDCNSLT",17,0) QST N DIR,DTOUT,DUOUT,CNSULT "RTN","SDCNSLT",18,0) S DIR(0)="Y",DIR("A")="Will this appointment be for a CONSULT/PROCEDURE",DIR("B")="YES",DIR("?")="Answer 'Y'es if appointment is for a Consult or Procedure." W ! D ^DIR S CNSULT=Y "RTN","SDCNSLT",19,0) I CNSULT[U!(CNSULT=0)!(CNSULT="") K TMP Q "RTN","SDCNSLT",20,0) HDR W !!,"Please select from the list of consult(s), press 0 for none.",! ;LLS 05-JAN-2015 SD*5.3*630 "RTN","SDCNSLT",21,0) W !,PTNM,!!,"# Service",?68,"Cons #",!,DSH ;LLS 05-JAN-2015 SD*5.3*630 "RTN","SDCNSLT",22,0) S A=0 F S A=$O(TMP(A)) Q:'+A S ND=TMP(A),P8=$P(ND,U,8) D ;LLS 05-JAN-2015 SD*5.3*630 "RTN","SDCNSLT",23,0) . W !,A,".",?3,$S(P8="P":$E($P(ND,U,9),1,63),1:$E($P(ND,U,2),1,63)),?68,$P(ND,U,6) W !,?4,"Request DT: ",$E($P(ND,U,5),1,14),?31,"FROM: ",$E($P(ND,U,3),1,33),?71,"TYPE: ",$S(P8="P":"P",P8="C":"C",1:"") ;LLS 05-JAN-2015 SD*5.3*630 "RTN","SDCNSLT",24,0) W ! "RTN","SDCNSLT",25,0) READ R !,"Select Consult: ",CONS:DTIME G:CONS="" A "RTN","SDCNSLT",26,0) I CONS=0!(CONS[U) W " ... NONE." K TMP Q "RTN","SDCNSLT",27,0) I "? "[CONS W !," Select consult by number on the left side." G READ "RTN","SDCNSLT",28,0) I '$D(TMP(CONS)) W *7," ?? Select consult by number on the left side." G READ "RTN","SDCNSLT",29,0) S CNSLTLNK=$P(TMP(CONS),U,6) "RTN","SDCNSLT",30,0) Q "RTN","SDCNSLT",31,0) SCHED(PTIEN,STPCOD,SHOW) ;===CONSULT IS SCHEDULE NOW CHECK IF IT HAS APPOINTMENT BY STOP CODE. "RTN","SDCNSLT",32,0) N APT,CLNC,B,S1,S2,S3,S4,STOP,STOPCOD,X,Y "RTN","SDCNSLT",33,0) S %DT="ST",X="T-1" D ^%DT S APT=Y,S1=0,STOP=0 F S APT=$O(^DPT(PTIEN,"S",APT)) Q:'+APT!(STOP) S S1=1,CLNC=$P(^DPT(PTIEN,"S",APT,0),U) I CLNC'="" S STOPCOD=$P(^SC(CLNC,0),U,7) I STOPCOD'="" S S2=0 I STOPCOD=STPCOD S S2=1 D "RTN","SDCNSLT",34,0) .S S3=0,S4=0,B=0 F S B=$O(^SC(CLNC,"S",APT,1,B)) Q:'+B!(STOP) S S3=1 D "RTN","SDCNSLT",35,0) ..I ($P($G(^SC(CLNC,"S",APT,1,B,0)),U)=PTIEN) S S4=1,STOP=1,SHOW=0 "RTN","SDCNSLT",36,0) I S1=0 S SHOW=1 Q ;show if no appointment in the patient side "RTN","SDCNSLT",37,0) I S2=0 S SHOW=1 Q ;show if stop code does not match "RTN","SDCNSLT",38,0) I S3=0 S SHOW=1 Q ;show if no appointment in the clinic "RTN","SDCNSLT",39,0) I S4=0 S SHOW=1 Q ;show if patient does not match in appointment "RTN","SDCNSLT",40,0) Q "RTN","SDCNSLT",41,0) LINK(SC,SDY,SD,CNSLTLNK) ;===LINK APPOINTMENT TO CONSULT "RTN","SDCNSLT",42,0) N DA,DIE,DR,TDA,X "RTN","SDCNSLT",43,0) S TDA=SDY,DA(2)=SC,DA(1)=SD,DA=TDA,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,",DR="688////^S X=CNSLTLNK" D ^DIE "RTN","SDCNSLT",44,0) Q "RTN","SDCNSLT",45,0) EDITCS(SD,TMPD,TMPYCLNC,CNSLTLNK) ;===MARK CONSULT AS SCHEDULED "RTN","SDCNSLT",46,0) N CSCHDT,SNDPRV,TME,X,Y,COMMENT,ER "RTN","SDCNSLT",47,0) S %DT="ST",X="NOW" D ^%DT S CSCHDT=Y "RTN","SDCNSLT",48,0) S SNDPRV=$P($G(^GMR(123,CNSLTLNK,0)),U,14),Y=SD D DD^%DT S TME=$P($P(Y,"@",2),":",1,2) "RTN","SDCNSLT",49,0) S COMMENT(1)=$P(TMPYCLNC,U,2)_" Consult Appt. on "_$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)_" @ "_TME "RTN","SDCNSLT",50,0) S COMMENT(2)=TMPD "RTN","SDCNSLT",51,0) D SCH^SDQQCN2(.ER,CNSLTLNK,SNDPRV,CSCHDT,0,,.COMMENT) K COMMENT "RTN","SDCNSLT",52,0) Q "RTN","SDCNSLT",53,0) SDECCAN(SCLNK,SCSNOD,SDTTM,SDSC,SDWH,SDPL,SDECNOTE) ; patch 686 wtc/zeb 3.21.18 cancel consult appointment. called from SDEC07A. "RTN","SDCNSLT",54,0) S SNDPRV=$P($G(^GMR(123,SCLNK,0)),U,14) ; "RTN","SDCNSLT",55,0) ; "RTN","SDCNSLT",56,0) CANCEL ;===appt was cancelled then mark consult as edit/resubmit, add comment. "RTN","SDCNSLT",57,0) N APPT,CONSULT,CPRSSTAT,ER,GM40,GMRND,SDPATNT,USER,SNDPRV,J "RTN","SDCNSLT",58,0) ;Variables CNDIE, CNDA and CNINDX used in calling routine for Cancel letter printed comment in consult. "RTN","SDCNSLT",59,0) ;TMPD is assumed by the existing code "RTN","SDCNSLT",60,0) S:$D(SDECNOTE) TMPD=SDECNOTE_$S($D(TMPD):"; ",1:"")_$G(TMPD) ;*zeb 686 10/30/18 keep cancel comment from GUI "RTN","SDCNSLT",61,0) S:$D(SCLNK) CONSULT=SCLNK "RTN","SDCNSLT",62,0) I SDPL S:'$D(SCLNK) CONSULT=$P($G(^SC(SDSC,"S",SDTTM,1,SDPL,"CONS")),U) ; check for value of SDPL - wtc 737 1/21/20 "RTN","SDCNSLT",63,0) Q:'+CONSULT "RTN","SDCNSLT",64,0) S:$D(SCSNOD) SDPATNT=$P(SCSNOD,U) "RTN","SDCNSLT",65,0) I SDPL S:'$D(SCSNOD) SDPATNT=$P($G(^SC(SDSC,"S",SDTTM,1,SDPL,0)),U) ; check for value of SDPL - wtc 737 1/21/20 "RTN","SDCNSLT",66,0) S CPRSSTAT=$P($G(^GMR(123,CONSULT,0)),U,12) I CPRSSTAT'="" S CPRSSTAT=$P($G(^ORD(100.01,CPRSSTAT,0)),U) Q:CPRSSTAT'="SCHEDULED" "RTN","SDCNSLT",67,0) S SNDPRV=$P($G(^GMR(123,CONSULT,0)),U,14) "RTN","SDCNSLT",68,0) S USER=$P(^VA(200,DUZ,0),U),Y=SDTTM D DD^%DT S APPT=$E(SDTTM,4,5)_"/"_$E(SDTTM,6,7)_"/"_$E(SDTTM,2,3)_" @ "_$P(Y,"@",2) "RTN","SDCNSLT",69,0) S COMMENT(1)=$P(^SC(SDSC,0),U)_" Appt. on "_APPT_" was cancelled"_$S($D(SDWH):$S(SDWH["P":" by the Patient.",SDWH["C":" by the Clinic.",1:"."),$D(SDADM):" for administrative purposes.",1:", whole clinic.") "RTN","SDCNSLT",70,0) S CNINDX=2 S:$D(TMPD) COMMENT(2)="Remarks: "_TMPD,CNINDX=CNINDX+1 K TMPD,SDECNOTE ;*zeb 686 10/30/18 clean up SDECNOTE in case SDECCAN not used "RTN","SDCNSLT",71,0) N SDERR S SDERR=$$STATUS^GMRCGUIS(CONSULT,6,3,SNDPRV,"","",.COMMENT) "RTN","SDCNSLT",72,0) S CNDIE="^GMR(123,"_CONSULT_",40,",CNDA=+$G(COMMENT(0)) "RTN","SDCNSLT",73,0) K COMMENT,DA "RTN","SDCNSLT",74,0) S AUTO(SDSC,SDTTM,SDPATNT)=CONSULT "RTN","SDCNSLT",75,0) I SDPL S DA(2)=SDSC,DA(1)=SDTTM,DA=SDPL,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,",DR="688///@" D ^DIE ; check for value of SDPL - wtc 737 1/21/20 "RTN","SDCNSLT",76,0) K SCSNOD,SDADM,SCLNK "RTN","SDCNSLT",77,0) Q "RTN","SDCNSLT",78,0) AUTOREB(SC,NDATE,LNK,CY) ;===AUTO REBOOK "RTN","SDCNSLT",79,0) N DIC,DA,DIE,DR,Y,TME,SNDPRV,CSCHDT,COMMENT,ER "RTN","SDCNSLT",80,0) S DA(2)=SC,DA(1)=NDATE,DA=CY,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,",DR="688////^S X=LNK" D ^DIE "RTN","SDCNSLT",81,0) S Y=NDATE D DD^%DT S TME=$P(Y,"@",2) "RTN","SDCNSLT",82,0) S COMMENT(1)=$P(^SC(SC,0),U)_" Consult Appt. on "_$E(NDATE,4,5)_"/"_$E(NDATE,6,7)_"/"_$E(NDATE,2,3)_" @ "_TME_" (Auto Rebooked)." "RTN","SDCNSLT",83,0) S %DT="ST",X="NOW" D ^%DT S CSCHDT=Y "RTN","SDCNSLT",84,0) S SNDPRV=$P($G(^GMR(123,LNK,0)),U,14) "RTN","SDCNSLT",85,0) D SCH^SDQQCN2(.ER,LNK,SNDPRV,CSCHDT,0,,.COMMENT) K COMMENT "RTN","SDCNSLT",86,0) Q "RTN","SDCNSLT",87,0) NOSHOW(SC,SDDTM,CNPAT,CNSTLNK,CN,AUTO,NSDIE,NSDA) ; "RTN","SDCNSLT",88,0) ;Appt. was a NoShow, then mark Consult as Edit/Resubmit, add comment using silent call to notify user. "RTN","SDCNSLT",89,0) ;Variables NSDIE and NSDA used in calling routine for NoShow letter printed comment in consult. "RTN","SDCNSLT",90,0) N CSNOD,CPRSSTAT,NOSHOW,CSRQSRV,TPRNT,CSPRT,USER,Y,APPT,COMMENT,DA,DIC,DUZ2,DIC,DR,GM40,GMRND,ER,SNDPRV,J "RTN","SDCNSLT",91,0) S CSNOD=$G(^GMR(123,CNSTLNK,0)),CPRSSTAT=$P(CSNOD,U,12),SNDPRV=$P(CSNOD,U,14),NOSHOW="no-show",AUTO(SC,SDDTM,CNPAT)=CNSTLNK "RTN","SDCNSLT",92,0) I CPRSSTAT'="" S CPRSSTAT=$P($G(^ORD(100.01,CPRSSTAT,0)),U) Q:CPRSSTAT'="SCHEDULED" "RTN","SDCNSLT",93,0) S CSRQSRV=$P(CSNOD,U,5) I CSRQSRV'="" S TPRNT=$P($G(^GMR(123.5,CSRQSRV,123)),U,9) I TPRNT'="" S:$P($G(^%ZIS(1,TPRNT,0)),U)'="" CSPRT=$P(^(0),U) ;reprint consult "RTN","SDCNSLT",94,0) S USER=$P(^VA(200,DUZ,0),U),Y=SDDTM D DD^%DT S APPT=$E(SDDTM,4,5)_"/"_$E(SDDTM,6,7)_"/"_$E(SDDTM,2,3)_" @ "_$P(Y,"@",2) "RTN","SDCNSLT",95,0) S COMMENT(1)=$P(^SC(SC,0),U)_" Appt. on "_APPT_" was a "_NOSHOW_"." ;no-show is a key word used by a search do not change "RTN","SDCNSLT",96,0) N SDERR S SDERR=$$STATUS^GMRCGUIS(CNSTLNK,6,3,SNDPRV,"","",.COMMENT) "RTN","SDCNSLT",97,0) S NSDIE="^GMR(123,"_CNSTLNK_",40,",NSDA=+$G(COMMENT(0)) "RTN","SDCNSLT",98,0) K COMMENT,DA "RTN","SDCNSLT",99,0) S DA(2)=SC,DA(1)=SDDTM,DA=CN,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,",DR="688///@" D ^DIE "RTN","SDCNSLT",100,0) I $D(CSPRT) D EN^GMRCP5(CNSTLNK,"C",CSPRT) "RTN","SDCNSLT",101,0) K CNSTLNK Q "RTN","SDEC50") 0^1^B169535547^B165813690 "RTN","SDEC50",1,0) SDEC50 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ; 01 Nov 2019 11:42 AM "RTN","SDEC50",2,0) ;;5.3;Scheduling;**627,658,665,672,722,723,737**;Aug 13, 1993;Build 13 "RTN","SDEC50",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","SDEC50",4,0) ; "RTN","SDEC50",5,0) Q "RTN","SDEC50",6,0) ; "RTN","SDEC50",7,0) FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) ; GET Future appointments for given patient and date range "RTN","SDEC50",8,0) ;FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) external parameter tag is in SDEC "RTN","SDEC50",9,0) ;INPUT: "RTN","SDEC50",10,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",11,0) ; SDBEG = (required) Begin of date range to search for appointments in external format "RTN","SDEC50",12,0) ; SDEND = (required) End of date range to search for appointments in external format "RTN","SDEC50",13,0) ; SDANC = (optional) ancillary flag 0=all appointments; 1=only ancillary appointments "RTN","SDEC50",14,0) ;RETURN: "RTN","SDEC50",15,0) ; Successful Return: "RTN","SDEC50",16,0) ; Global Array in which each array entry contains Appointment Data from the PATIENT file "RTN","SDEC50",17,0) ; Data is separated by ^: "RTN","SDEC50",18,0) ; 1. DFN "RTN","SDEC50",19,0) ; 2. CLINIC_IEN - Clinic IEN "RTN","SDEC50",20,0) ; 3. CLINIC_NAME - Clinic Name "RTN","SDEC50",21,0) ; 4. APPT_DATE - Appointment Date in external format "RTN","SDEC50",22,0) ; 5. STATUS - Status text "RTN","SDEC50",23,0) ; 6. ANCTXT - Ancillary Text "RTN","SDEC50",24,0) ; 7. CONS -Consult Link pointer to REQUEST/CONSULTATION file 123 "RTN","SDEC50",25,0) ; "T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT^T00030CONS" "RTN","SDEC50",26,0) ; Caught Exception Return: "RTN","SDEC50",27,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",28,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",29,0) ; "RTN","SDEC50",30,0) N IEN,SDANCT,SDCL,SDCLN,SDCONS,SDATA,SDDT,SDST,SDT,X,Y,%DT "RTN","SDEC50",31,0) N SDTMP,SDTYP,SDTYPN,SDNOD,SDRES,SDNOD2,SDLNK ;alb/sat 672 ;*zeb 723 5/2/19 added SDNOD2,SDLNK "RTN","SDEC50",32,0) S SDECI=0 "RTN","SDEC50",33,0) K ^TMP("SDEC50",$J) "RTN","SDEC50",34,0) S SDECY="^TMP(""SDEC50"","_$J_")" "RTN","SDEC50",35,0) ; data header "RTN","SDEC50",36,0) S SDTMP="T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT" "RTN","SDEC50",37,0) S SDTMP=SDTMP_"^T00030CONS^T00030IEN^T00030APPTYPE_IEN^T00030APPTYPE_NAME" ;alb/sat 658 add IEN ;alb/sat 672 add APPTYPE "RTN","SDEC50",38,0) S @SDECY@(0)=SDTMP_$C(30) "RTN","SDEC50",39,0) ;validate Patient (required) "RTN","SDEC50",40,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",41,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",42,0) ;validate begin date/time (required) "RTN","SDEC50",43,0) S:$G(SDBEG)="" SDBEG=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",44,0) S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y "RTN","SDEC50",45,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid Begin Time.",.SDECI,SDECY) Q "RTN","SDEC50",46,0) ;validate end date/time (required) "RTN","SDEC50",47,0) S:$G(SDEND)="" SDEND=1000000 "RTN","SDEC50",48,0) S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y "RTN","SDEC50",49,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid End Time.",.SDECI,SDECY) Q "RTN","SDEC50",50,0) ;validate ancillary flag (optional) "RTN","SDEC50",51,0) S SDANC=$G(SDANC) "RTN","SDEC50",52,0) S:SDANC'=1 SDANC=0 "RTN","SDEC50",53,0) ;*zeb 722 1/9/19 begin new loop over appts instead of pt "RTN","SDEC50",54,0) S SDT=SDBEG "RTN","SDEC50",55,0) F S SDT=$O(^SDEC(409.84,"APTDT",DFN,SDT)) Q:SDT="" Q:$P(SDT,".",1)>SDEND D "RTN","SDEC50",56,0) . S IEN="" "RTN","SDEC50",57,0) . F S IEN=$O(^SDEC(409.84,"APTDT",DFN,SDT,IEN)) Q:IEN="" D "RTN","SDEC50",58,0) .. S SDNOD=$G(^SDEC(409.84,IEN,0)) "RTN","SDEC50",59,0) .. Q:SDNOD="" ;appointment data missing "RTN","SDEC50",60,0) .. S SDATA=$G(^DPT(DFN,"S",SDT,0)) "RTN","SDEC50",61,0) .. S SDANCT=$$ANC^SDAM1() ;assumes SDATA ;ancillary "RTN","SDEC50",62,0) .. I SDANC Q:SDANCT="" "RTN","SDEC50",63,0) .. ;return appointment data "RTN","SDEC50",64,0) .. S SDRES=$P(SDNOD,U,7) "RTN","SDEC50",65,0) .. S SDCL="",SDCLN="*CORRUPT DATA" ;*zeb+8 723 5/2/19 support appointments with no resource "RTN","SDEC50",66,0) .. I SDRES]"" S SDCL=$$GET1^DIQ(409.831,SDRES_",",.04,"I") S SDCLN=$$GET1^DIQ(409.831,SDRES_",",.04) ;clinic IEN/clinic name "RTN","SDEC50",67,0) .. S SDDT=$$GET1^DIQ(409.84,IEN_",",.01) ;appointment start date/time ;used GET1 instead of ^DD("DD") because GUI needs leading zeroes "RTN","SDEC50",68,0) .. S SDST=$$APPTSTS(IEN,SDNOD,SDCL) ;current status "RTN","SDEC50",69,0) .. S SDTYP=$P(SDNOD,U,6) ;appt type id "RTN","SDEC50",70,0) .. I SDTYP S SDTYPN=$P($G(^SD(409.1,SDTYP,0)),U,1) ;appt type name "RTN","SDEC50",71,0) .. E S SDTYPN="REGULAR",SDTYP=$O(^SD(409.1,"B",SDTYPN,0)) ; Handle missing appt type 737 WTC 11/19/2019 "RTN","SDEC50",72,0) .. S SDNOD2=$G(^SDEC(409.84,IEN,2)),SDLNK="" "RTN","SDEC50",73,0) .. S SDLNK=$S(SDNOD2="":"",1:$P(SDNOD2,U,1)) "RTN","SDEC50",74,0) .. S CONS=$S(SDLNK="":"",$P(SDLNK,";",2)["GMR":$P(SDLNK,";",1),1:"") "RTN","SDEC50",75,0) .. S SDECI=SDECI+1 S @SDECY@(SDECI)=DFN_U_SDCL_U_SDCLN_U_SDDT_U_SDST_U_SDANCT_U_CONS_U_IEN_U_SDTYP_U_SDTYPN_$C(30) "RTN","SDEC50",76,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",77,0) Q "RTN","SDEC50",78,0) ; "RTN","SDEC50",79,0) ;*zeb+tag 722 2/19/19 added to get appointment status for pending appointments from appointment file "RTN","SDEC50",80,0) APPTSTS(APPTIEN,APPTNOD,CLINIEN) ;Get current status for an entry in the SDEC APPOINTMENT file in the style of STATUS^SDAM1 "RTN","SDEC50",81,0) ;APPTIEN (R) - IEN of entry in the SDEC APPOINTMENT file (#409.84) "RTN","SDEC50",82,0) ;APPTNOD (O) - 0 node of appointment entry (will be read if not passed in) "RTN","SDEC50",83,0) ;CLINIEN (O) - IEN of entry in the HOSPITAL LOCATION file (#44); non-count will not be checked via clinic if not passed in (can check via OE) "RTN","SDEC50",84,0) N STS,OEIEN,DFN,SDT,VAINDT,VADMVT,CHKIO,RET,OESTS,CXLRSN,CXLRSNTP,CXLSTS ; Added variables to list wtc 8/27/19 "RTN","SDEC50",85,0) I $G(APPTNOD)="" S APPTNOD=$G(^SDEC(409.84,APPTIEN,0)) "RTN","SDEC50",86,0) S SDT=$P(APPTNOD,U,1) "RTN","SDEC50",87,0) S DFN=$P(APPTNOD,U,5) "RTN","SDEC50",88,0) S OEIEN=$P($G(^DPT(DFN,"S",SDT,0)),U,20) "RTN","SDEC50",89,0) S CHKIO="" "RTN","SDEC50",90,0) ; -- set initial status value ; non-count clinic? "RTN","SDEC50",91,0) S STS=$P(APPTNOD,U,17) "RTN","SDEC50",92,0) I STS]"" S STS=$P($P($P(^DD(409.84,.17,0),"^",3),STS_":",2),";",1) I 1 ;name for status code "RTN","SDEC50",93,0) E I CLINIEN]"" S:$P($G(^SC(CLINIEN,0)),U,17)="Y" STS="NON-COUNT" ;check for non-count clinic ;*zeb+1 723 5/2/19 don't crash if resource/clinic not available "RTN","SDEC50",94,0) I CLINIEN'="",STS="NO ACTION TAKEN",OEIEN'="" S STS="" ; wtc 723 8/20/2019 "RTN","SDEC50",95,0) ; -- no show? "RTN","SDEC50",96,0) I $P(APPTNOD,U,10)=1 D "RTN","SDEC50",97,0) . I $P(APPTNOD,U,12)]"" D Q ;handle cancel after no-show -- appt sts doesn't get updated with cxl but pt status does "RTN","SDEC50",98,0) . . S CXLRSN=$P(APPTNOD,U,22) "RTN","SDEC50",99,0) . . I CXLRSN="" S STS="CANCELLED" Q ;cancel reason is required, this should not happen "RTN","SDEC50",100,0) . . S CXLRSNTP=$P($G(^SD(409.2,CXLRSN,0)),U,2) "RTN","SDEC50",101,0) . . I CXLRSNTP="C" S STS="CANCELLED BY CLINIC" Q "RTN","SDEC50",102,0) . . I CXLRSNTP="P" S STS="CANCELLED BY PATIENT" Q "RTN","SDEC50",103,0) . . ;only reasons that can be either are left, check pt file status -- could be overlaid after cancel "RTN","SDEC50",104,0) . . S CXLSTS=$$GET1^DIQ(2.98,SDT_","_DFN_",",100) "RTN","SDEC50",105,0) . . I CXLSTS["CANCELLED" S STS=CXLSTS Q "RTN","SDEC50",106,0) . . S STS="CANCELLED BY CLINIC" ;must specify clinic or patient, default to clinic if information is lost "RTN","SDEC50",107,0) . S STS="NO-SHOW" "RTN","SDEC50",108,0) ; -- inpatient? "RTN","SDEC50",109,0) ; WTC 722 3/22/19 ; "RTN","SDEC50",110,0) I STS=""!($P(APPTNOD,U,17)="I"),$$INP^SDAM2(DFN,SDT)="I" S STS=$S($P(APPTNOD,U,12)="":"INPATIENT",$P($G(^DPT(DFN,"S",SDT,0)),U,2)="PC":"CANCELLED BY PATIENT",1:"CANCELLED BY CLINIC") ; WTC 722 3/27/2019 "RTN","SDEC50",111,0) S VAINDT=SDT D ADM^VADPT2 ;ADM^VADPT2 assumes VAINDT and returns in VADMVT "RTN","SDEC50",112,0) I STS["INPATIENT",$S('VADMVT:1,'$P(^DG(43,1,0),U,21):0,1:$P($G(^DIC(42,+$P($G(^DGPM(VADMVT,0)),U,6),0)),U,3)="D") S STS="" "RTN","SDEC50",113,0) ; -- determine ci/co indicator "RTN","SDEC50",114,0) S CHKIO=$S($P(APPTNOD,U,14)]"":"CHECKED OUT",$P(APPTNOD,U,3)]"":"CHECKED IN",SDT>(DT+.2400):"FUTURE",1:"NO ACTION TAKEN") ;DT is a FileMan-assumable variable with the current date "RTN","SDEC50",115,0) ; "RTN","SDEC50",116,0) ; Look for check-in time in the Location file (#44) if check-in/out indicator is NO ACTION TAKEN. Needed 'cause VPS does not update Appointment file. wtc 10/31/2019 737 "RTN","SDEC50",117,0) I CHKIO="NO ACTION TAKEN",CLINIEN'="" D ; "RTN","SDEC50",118,0) . N SDECD2 S SDECD2=$$FIND^SDAM2(DFN,SDT,CLINIEN) I SDECD2,$P($G(^SC(CLINIEN,"S",SDT,1,SDECD2,"C")),U,1)'="" S CHKIO="CHECKED IN" ; "RTN","SDEC50",119,0) ; "RTN","SDEC50",120,0) S:STS="" STS=CHKIO "RTN","SDEC50",121,0) ; "RTN","SDEC50",122,0) ; If status is NO ACTION TAKEN, check if cancelled in Patient file (by SDCANCEL), wtc 11/4/2019 737 "RTN","SDEC50",123,0) ; Changed to if status not cancelled, check if cancelled in Patient file. wtc 1/17/2020 737 "RTN","SDEC50",124,0) ; "RTN","SDEC50",125,0) I STS'["CANCELLED" D ; "RTN","SDEC50",126,0) . I $P($G(^DPT(DFN,"S",SDT,0)),U,1)'=CLINIEN Q ; If appointment does not match, leave status alone. "RTN","SDEC50",127,0) . S STS=$S($P($G(^DPT(DFN,"S",SDT,0)),U,2)="PC":"CANCELLED BY PATIENT",$P($G(^DPT(DFN,"S",SDT,0)),U,2)="C":"CANCELLED BY CLINIC",1:STS) ; "RTN","SDEC50",128,0) ; "RTN","SDEC50",129,0) I (STS="NO ACTION TAKEN"),($P(SDT,".")=DT),(CHKIO'["CHECKED") S CHKIO="TODAY" "RTN","SDEC50",130,0) ; -- determine print status "RTN","SDEC50",131,0) I STS["CANCELLED" Q STS "RTN","SDEC50",132,0) S RET=$S(STS=CHKIO!(CHKIO=""):STS,1:"") "RTN","SDEC50",133,0) I RET="" D "RTN","SDEC50",134,0) . I STS["INPATIENT",$P(SDT,".",1)>DT S RET=$P(STS," ",1)_"/FUTURE" Q ; WTC 3/26/19 722 "RTN","SDEC50",135,0) . I (STS["INPATIENT"),(CLINIEN]""),($P($G(^SC(CLINIEN,0)),U,17)'="Y"),OEIEN="" S RET=$P(STS," ",1)_"/ACT REQ" Q ; wtc 3/22/19 722 no outpatient encounter for inpatient "RTN","SDEC50",136,0) . I (STS["INPATIENT"),(CLINIEN]""),($P($G(^SC(CLINIEN,0)),U,17)'="Y"),($P($G(^SCE(OEIEN,0)),U,7)="") S RET=$P(STS," ",1)_"/ACT REQ" Q "RTN","SDEC50",137,0) . I (STS="NO ACTION TAKEN"),((CHKIO="CHECKED OUT")!(CHKIO="CHECKED IN")) S RET="ACT REQ/"_CHKIO D Q "RTN","SDEC50",138,0) . . I (OEIEN),($P($G(^SCE(OEIEN,0)),U,7)) S RET="CHECKED OUT" ; wtc 722 8/27/19 changed P to RET to match code in SDAM1, where the code originally came from. "RTN","SDEC50",139,0) . I ((STS="NO-SHOW")!(STS="NON-COUNT")) S RET=STS Q:CHKIO="NO ACTION TAKEN" "RTN","SDEC50",140,0) . S RET=STS_"/"_CHKIO "RTN","SDEC50",141,0) I STS["INPATIENT",((CHKIO="")!(CHKIO="NO ACTION TAKEN")) D "RTN","SDEC50",142,0) . I SDT>(DT+.2359) S RET=$P(STS," ")_"/FUTURE" Q "RTN","SDEC50",143,0) . S RET=$P(STS," ")_"/NO ACT TAKN" "RTN","SDEC50",144,0) I STS["INPATIENT" Q RET "RTN","SDEC50",145,0) I STS["NO-SHOW" Q RET "RTN","SDEC50",146,0) I ($G(OEIEN)),($D(^SCE(OEIEN,0))) D "RTN","SDEC50",147,0) . S OESTS=$P($G(^SCE(OEIEN,0)),U,12) "RTN","SDEC50",148,0) . S:OESTS]"" OESTS=$P($G(^SD(409.63,OESTS,0)),U,1) "RTN","SDEC50",149,0) . I $G(OESTS)="NON-COUNT" D Q "RTN","SDEC50",150,0) . . I $P(APPTNOD,U,14) S RET="NON-COUNT/CHECKED OUT" Q "RTN","SDEC50",151,0) . . I $P(APPTNOD,U,3) S RET="NON-COUNT/CHECKED IN" "RTN","SDEC50",152,0) . I $G(OESTS)="CHECKED OUT" S RET="CHECKED OUT" Q "RTN","SDEC50",153,0) . I $P(APPTNOD,U,14) S RET="ACT REQ/CHECKED OUT" D Q "RTN","SDEC50",154,0) . . I ($G(OESTS)=""),($P($G(^SCE(OEIEN,0)),U,7)) S RET="CHECKED OUT" "RTN","SDEC50",155,0) . I $P(APPTNOD,U,3) S RET="ACT REQ/CHECKED IN" "RTN","SDEC50",156,0) Q RET "RTN","SDEC50",157,0) ; "RTN","SDEC50",158,0) GETIEN(DFN,SDCLN,SDDT) ;get SDEC APPOINTMENT id "RTN","SDEC50",159,0) N SDF,SDI,SDNOD,SDR "RTN","SDEC50",160,0) Q:$G(DFN)="" "" "RTN","SDEC50",161,0) Q:$G(SDCLN)="" "" "RTN","SDEC50",162,0) Q:$G(SDDT)="" "" "RTN","SDEC50",163,0) S (SDF,SDI)=0 F S SDI=$O(^SDEC(409.84,"CPAT",DFN,SDI)) Q:SDI="" D Q:SDF=1 "RTN","SDEC50",164,0) .S SDNOD=$G(^SDEC(409.84,SDI,0)) "RTN","SDEC50",165,0) .Q:SDNOD="" "RTN","SDEC50",166,0) .S SDR=$$GETRES^SDECUTL(SDCLN) "RTN","SDEC50",167,0) .I $P(SDNOD,U,1)=SDDT,$P(SDNOD,U,7)=SDR S SDF=1 "RTN","SDEC50",168,0) Q $S(SDI'="":SDI,1:"") "RTN","SDEC50",169,0) ; "RTN","SDEC50",170,0) CONS(SDCL,DFN,SDDT) ;check for consult in file 44 "RTN","SDEC50",171,0) ; SDCL = (required) clinic IEN "RTN","SDEC50",172,0) ; DFN = (required) patient IEN "RTN","SDEC50",173,0) ; SDDT = (required) appointment time in FM format "RTN","SDEC50",174,0) N CONS,CSTAT,SDI,SDJ "RTN","SDEC50",175,0) S CONS="" "RTN","SDEC50",176,0) S SDI=0 F S SDI=$O(^SC(SDCL,"S",SDDT,1,SDI)) Q:SDI'>0 D Q:CONS'="" "RTN","SDEC50",177,0) .I $P($G(^SC(SDCL,"S",SDDT,1,SDI,0)),U,1)=DFN D "RTN","SDEC50",178,0) ..S CONS=$G(^SC(SDCL,"S",SDDT,1,SDI,"CONS")) "RTN","SDEC50",179,0) ..I +CONS D "RTN","SDEC50",180,0) ...S CSTAT=$P($G(^GMR(123,CONS,0)),U,12) "RTN","SDEC50",181,0) ...S:(CSTAT=1!(CSTAT=2)!(CSTAT=13)) CONS="" "RTN","SDEC50",182,0) Q CONS "RTN","SDEC50",183,0) ; "RTN","SDEC50",184,0) PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) ;GET patient clinic status for a clinic for a given time frame - has the patient been seen by the given Clinic in the past 24 months "RTN","SDEC50",185,0) ;PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",186,0) ;INPUT: "RTN","SDEC50",187,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",188,0) ; SDCL = (required) Clinic code - Pointer to HOSPITAL LOCATION file "RTN","SDEC50",189,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",190,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",191,0) ;RETURN: "RTN","SDEC50",192,0) ; Successful Return: "RTN","SDEC50",193,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",194,0) ; not been seen. "RTN","SDEC50",195,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",196,0) ; Caught Exception Return: "RTN","SDEC50",197,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",198,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",199,0) ; "RTN","SDEC50",200,0) N SDASD,SDECI,SDS,STOP,SDYN,SDSCL "RTN","SDEC50",201,0) ;N SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN alb/jsm 658 commented out since variables not used here "RTN","SDEC50",202,0) N X,Y,%DT,APIEN "RTN","SDEC50",203,0) S SDECI=0 "RTN","SDEC50",204,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSTGET"")" "RTN","SDEC50",205,0) K @SDECY "RTN","SDEC50",206,0) ; data header "RTN","SDEC50",207,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",208,0) ;check for valid Patient "RTN","SDEC50",209,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",210,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",211,0) ;check for valid Clinic "RTN","SDEC50",212,0) I '+SDCL D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",213,0) I '$D(^SC(SDCL,0)) D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",214,0) ;check times "RTN","SDEC50",215,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",216,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",217,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" ;alb/sat 665 - remove Q "RTN","SDEC50",218,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",219,0) S STOP=$$CLSTOP(SDCL) ;get stop code number alb/jsm 658 updated to use new CLSTOP call "RTN","SDEC50",220,0) I '+STOP D ERR1^SDECERR(-1,"Clinic "_$P($G(^SC(+$G(SDCL),0)),U,1)_" does not have a STOP CODE NUMBER defined.",SDECI,SDECY) Q "RTN","SDEC50",221,0) S SDYN="NO" "RTN","SDEC50",222,0) D CHKPT "RTN","SDEC50",223,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",224,0) Q "RTN","SDEC50",225,0) ; "RTN","SDEC50",226,0) CLSTOP(CLINIC) ;Return clinic stop code for clinic "RTN","SDEC50",227,0) Q:$G(CLINIC)="" 0 ;Verify clinic is passed in "RTN","SDEC50",228,0) Q $P($G(^SC(CLINIC,0)),U,7) ;Return the stop code for the clinic "RTN","SDEC50",229,0) ; "RTN","SDEC50",230,0) CHKPT ; alb/jsm 658 added to be used by PCSTGET and PCST2GET "RTN","SDEC50",231,0) N SDSCO "RTN","SDEC50",232,0) S SDS=0 F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" ;alb/sat 665 - start with SDS=0 instead of "" "RTN","SDEC50",233,0) .S SDSCL=$P($G(^DPT(DFN,"S",SDS,0)),U,1) "RTN","SDEC50",234,0) .I $$CLSTOP(SDSCL)=STOP D "RTN","SDEC50",235,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDSCL) "RTN","SDEC50",236,0) ..Q:APIEN="" "RTN","SDEC50",237,0) ..S SDSCO=$P($P($G(^SC(SDSCL,"S",SDS,1,+APIEN,"C")),U,3),".",1) "RTN","SDEC50",238,0) ..S:(SDSCO'="")&(SDSCO'SDEND) SDYN="YES" "RTN","SDEC50",239,0) Q "RTN","SDEC50",240,0) ; "RTN","SDEC50",241,0) PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) ;GET patient clinic status for a service/specialty (clinic stop) for a given time frame - has the patient been seen any clinics with the given service/specialty (clinic stop) in the past 24 months "RTN","SDEC50",242,0) ;PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",243,0) ;INPUT: "RTN","SDEC50",244,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",245,0) ; STOP = (required) CLINIC STOP or Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",246,0) ; OR - Pointer to the CLINIC STOP file "RTN","SDEC50",247,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",248,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",249,0) ;RETURN: "RTN","SDEC50",250,0) ; Successful Return: "RTN","SDEC50",251,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",252,0) ; not been seen. "RTN","SDEC50",253,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",254,0) ; Caught Exception Return: "RTN","SDEC50",255,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",256,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",257,0) ; "RTN","SDEC50",258,0) N SDASD,SDF,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN "RTN","SDEC50",259,0) N H,WLSRVSP,X,Y,%DT "RTN","SDEC50",260,0) S WLSRVSP="" "RTN","SDEC50",261,0) S (SDF,SDECI,SDSCN)=0 "RTN","SDEC50",262,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCST2GET"")" "RTN","SDEC50",263,0) K @SDECY "RTN","SDEC50",264,0) ; data header "RTN","SDEC50",265,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",266,0) ;check for valid Patient "RTN","SDEC50",267,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",268,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",269,0) ;check for valid Service/Specialty "RTN","SDEC50",270,0) S STOP=$G(STOP) "RTN","SDEC50",271,0) I +STOP,'$D(^DIC(40.7,STOP,0)) D ERR1^SDECERR(-1,"Invalid stop code.",SDECI,SDECY) Q "RTN","SDEC50",272,0) I +STOP S SDSCN=$$GET1^DIQ(40.7,STOP_",",.01) S SDF=1 "RTN","SDEC50",273,0) I 'SDF,'+STOP D "RTN","SDEC50",274,0) .S H="" F S H=$O(^DIC(40.7,"B",STOP,H)) Q:H="" D Q:+STOP "RTN","SDEC50",275,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",276,0) ..S STOP=H "RTN","SDEC50",277,0) I '+STOP D ERR1^SDECERR(-1,"Invalid Stop code.",SDECI,SDECY) Q "RTN","SDEC50",278,0) ;check times "RTN","SDEC50",279,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",280,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",281,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" Q "RTN","SDEC50",282,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",283,0) S SDYN="NO" "RTN","SDEC50",284,0) D CHKPT "RTN","SDEC50",285,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",286,0) Q "RTN","SDEC50",287,0) ; "RTN","SDEC50",288,0) LOOK ; "RTN","SDEC50",289,0) ;look in PATIENT Appointments "RTN","SDEC50",290,0) I SDYN'="YES" D "RTN","SDEC50",291,0) .S SDS="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",292,0) ..S SDSD=$$GET1^DIQ(2.98,SDS_","_DFN_",",.001,"I") "RTN","SDEC50",293,0) ..I (SDSD'SDEND) D "RTN","SDEC50",294,0) ...I $P($G(^DPT(DFN,"S",SDS,0)),U,1)=SDCL D "RTN","SDEC50",295,0) ....S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",296,0) ....I APIEN'="",$G(^SC(SDCL,"S",SDS,1,APIEN,"C"))'="" S SDYN="YES" "RTN","SDEC50",297,0) ;look in HOSPITAL LOCATION "RTN","SDEC50",298,0) I SDYN'="YES" D "RTN","SDEC50",299,0) .S SDS=SDBEG F S SDS=$O(^SC(SDCL,"S",SDS)) Q:SDS'>0 Q:SDS>SDEND D Q:SDYN="YES" "RTN","SDEC50",300,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",301,0) ..Q:APIEN="" "RTN","SDEC50",302,0) ..S:$P($G(^SC(SDCL,"S",SDS,1,APIEN,"C")),U,1)'="" SDYN="YES" "RTN","SDEC50",303,0) Q "RTN","SDEC50",304,0) ; "RTN","SDEC50",305,0) LOOKWL ; "RTN","SDEC50",306,0) ;look in SD WAIT LIST file for STOP stop code "RTN","SDEC50",307,0) S SDWL="" F S SDWL=$O(^SDWL(409.3,"B",DFN,SDWL)) Q:SDWL="" D Q:SDYN="YES" "RTN","SDEC50",308,0) .S SDSD=$P($G(^SDWL(409.3,SDWL,0)),U,23) "RTN","SDEC50",309,0) .I (SDSD'SDEND) D "RTN","SDEC50",310,0) ..S SDSTP=$P($G(^SDWL(409.3,SDWL,"SDAPT")),U,4) "RTN","SDEC50",311,0) ..I SDSTP=STOP S SDYN="YES" "RTN","SDEC50",312,0) .Q:SDYN="YES" "RTN","SDEC50",313,0) Q "RTN","SDEC50",314,0) ; "RTN","SDEC50",315,0) PCSGET(SDECY,SDSVSP,SDCL) ;GET clinics for a service/specialty (clinic stop) ;alb/sat 658 add SDCL "RTN","SDEC50",316,0) ;PCSGET(SDECY,SDSVSP) external parameter tag is in SDEC "RTN","SDEC50",317,0) ;INPUT: "RTN","SDEC50",318,0) ; SDSVSP = (required) Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",319,0) ; OR - Pointer to the SD WL SERVICE/SPECIALTY file "RTN","SDEC50",320,0) ;RETURN: "RTN","SDEC50",321,0) ; Successful Return: "RTN","SDEC50",322,0) ; global array containing Clinic IEN and Name of matching Hospital Locations "RTN","SDEC50",323,0) ; CLINSTOP - pointer to CLINIC STOP file 40.7 "RTN","SDEC50",324,0) ; CLINIEN - pointer to the HOSPITAL LOCATION file 44 "RTN","SDEC50",325,0) ; CLINNAME - NAME from the HOSPITAL LOCATION file "RTN","SDEC50",326,0) ; Caught Exception Return: "RTN","SDEC50",327,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",328,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",329,0) ; "RTN","SDEC50",330,0) N SDASD,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL "RTN","SDEC50",331,0) N H,WLSRVSP,X,Y "RTN","SDEC50",332,0) S WLSRVSP="" "RTN","SDEC50",333,0) S (SDECI,SDSCN)=0 "RTN","SDEC50",334,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSGET"")" "RTN","SDEC50",335,0) K @SDECY "RTN","SDEC50",336,0) ; data header "RTN","SDEC50",337,0) S @SDECY@(0)="T00030CLINSTOP^T00030CLINIEN^T00030CLINNAME"_$C(30) "RTN","SDEC50",338,0) ;check clinic ;alb/sat 658 "RTN","SDEC50",339,0) S SDCL=$G(SDCL) "RTN","SDEC50",340,0) I SDCL'="",$D(^SC(SDCL,0)) D "RTN","SDEC50",341,0) .S SDSVSP=$$GET1^DIQ(44,SDCL_",",8,"I") "RTN","SDEC50",342,0) ;check for valid Service/Specialty "RTN","SDEC50",343,0) S SDSVSP=$G(SDSVSP) "RTN","SDEC50",344,0) I SDSVSP="" D ERR1^SDECERR(-1,"Service/Specialty ID required",SDECI,SDECY) Q "RTN","SDEC50",345,0) I +SDSVSP,$D(^SDWL(409.31,+SDSVSP,0)) S SDSCN=$P($G(^SDWL(409.31,SDSVSP,0)),U,1) "RTN","SDEC50",346,0) I '+SDSVSP D "RTN","SDEC50",347,0) .S H=0 F S H=$O(^DIC(40.7,"B",SDSVSP,H)) Q:H="" D Q:SDSCN'=0 "RTN","SDEC50",348,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",349,0) ..S SDSCN=H "RTN","SDEC50",350,0) I '+SDSCN D ERR1^SDECERR(-1,"Invalid Service/Specialty.",SDECI,SDECY) Q "RTN","SDEC50",351,0) S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D "RTN","SDEC50",352,0) .S SDCLN=$P($G(^SC(SDCL,0)),U,7) "RTN","SDEC50",353,0) .I $$GET1^DIQ(44,SDCL_",",2505,)'="",$$GET1^DIQ(44,SDCL_",",2506)="" Q ;only active "RTN","SDEC50",354,0) .I SDCLN=SDSCN S SDECI=SDECI+1 S @SDECY@(SDECI)=SDSCN_U_SDCL_U_$P($G(^SC(SDCL,0)),U,1)_$C(30) "RTN","SDEC50",355,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",356,0) Q "RTN","SDEC50",357,0) ; "RTN","SDECSTSQ") 0^3^B35405698^n/a "RTN","SDECSTSQ",1,0) SDECSTSQ ; ALB/WTC - VISTA SCHEDULING GUI; 21 Aug 2019 7:10 AM ; 13 Nov 2019 9:28 AM "RTN","SDECSTSQ",2,0) ;;5.3;Scheduling;**737**;;Build 13 "RTN","SDECSTSQ",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","SDECSTSQ",4,0) Q "RTN","SDECSTSQ",5,0) ; "RTN","SDECSTSQ",6,0) ; Report appointment-encounter-appointment status triples from the patient file (#2), the encounter file (#409.68) and the appointment file (#409.84). "RTN","SDECSTSQ",7,0) ; "RTN","SDECSTSQ",8,0) ; ICR "RTN","SDECSTSQ",9,0) ; --- "RTN","SDECSTSQ",10,0) ; 7030 - #2 patient appointment data "RTN","SDECSTSQ",11,0) ; "RTN","SDECSTSQ",12,0) FIND ; "RTN","SDECSTSQ",13,0) ; "RTN","SDECSTSQ",14,0) ; Entry point for report only. "RTN","SDECSTSQ",15,0) ; "RTN","SDECSTSQ",16,0) W !!,"Generate report showing status of patient appointment, encounter or appointment file entries for a single status triple.",! ; "RTN","SDECSTSQ",17,0) ; "RTN","SDECSTSQ",18,0) N REPORT,POP,IO,%ZIS ; "RTN","SDECSTSQ",19,0) S REPORT="YES" ; "RTN","SDECSTSQ",20,0) S %ZIS="Q" D ^%ZIS Q:POP ; Added code to output to printer. wtc 9/17/2019 "RTN","SDECSTSQ",21,0) ; "RTN","SDECSTSQ",22,0) FIND0 ; "RTN","SDECSTSQ",23,0) ; "RTN","SDECSTSQ",24,0) ; Find patient appointment-encounter-appointment file combinations that match selected criteria "RTN","SDECSTSQ",25,0) ; "RTN","SDECSTSQ",26,0) N %DT,Y,START,X,DIC,PTSTATUS,ENCSTATUS,APPTSTATUS,NAME,DFN,DTTM,PTDATA,ENCOUNTER,ENCDATA,APPTIEN,APPTDATA,FIRST,COUNT,FIELDS,FIELD,I ; "RTN","SDECSTSQ",27,0) ; "RTN","SDECSTSQ",28,0) ; START = Beginning date of appointments in list "RTN","SDECSTSQ",29,0) ; PTSTATUS = Status of appointment in patient file "RTN","SDECSTSQ",30,0) ; ENCSTATUS = Status of encounter "RTN","SDECSTSQ",31,0) ; APPTSTATUS = Status of appointment in appointment file "RTN","SDECSTSQ",32,0) ; NAME = Patient's name "RTN","SDECSTSQ",33,0) ; DFN = Patient pointer (#2) "RTN","SDECSTSQ",34,0) ; DTTM = Appointment date/time (FM format) "RTN","SDECSTSQ",35,0) ; PTDATA = Data record from patient's appointment (ICR #7030) "RTN","SDECSTSQ",36,0) ; ENCOUNTER = Encounter pointer (#409.68) "RTN","SDECSTSQ",37,0) ; ENCDATA = Data record from encounter "RTN","SDECSTSQ",38,0) ; APPTIEN = Appointment pointer (#409.84) "RTN","SDECSTSQ",39,0) ; APPTDATA = Data record from appointment "RTN","SDECSTSQ",40,0) ; FIRST = Flag indicating that the appointment in the appointment file is the first to match the appointment in the patient file "RTN","SDECSTSQ",41,0) ; COUNT = Total number of appointment-encounter-appointment triples found "RTN","SDECSTSQ",42,0) ; FIELDS = Set of codes fields from patient appointment multiple or appointment file used to display help text "RTN","SDECSTSQ",43,0) ; FIELD = Individual set of codes value used to display help text "RTN","SDECSTSQ",44,0) ; "RTN","SDECSTSQ",45,0) U 0 W !,"Select starting date to check",! ; "RTN","SDECSTSQ",46,0) S %DT="AX" D ^%DT Q:Y<0 S START=$P(Y,".",1) W ! ; "RTN","SDECSTSQ",47,0) ; "RTN","SDECSTSQ",48,0) ; The user selects the appointment-encounter-appointment triple by identifying the status of the patient appointment (#2), the encounter (#409.68) "RTN","SDECSTSQ",49,0) ; and the appointment file entry (#409.84). The allowable status values come from the status data fields in each of the files plus NULL for all "RTN","SDECSTSQ",50,0) ; 3 files and NONE for the encounter and appointment files. "RTN","SDECSTSQ",51,0) ; "RTN","SDECSTSQ",52,0) FIND1 ; "RTN","SDECSTSQ",53,0) R !,"Select patient appointment status: ",X:$S($G(DTIME):DTIME,1:300) Q:'$T Q:X="" Q:X="^" ; "RTN","SDECSTSQ",54,0) ; "RTN","SDECSTSQ",55,0) I X="?" W !!,"Enter a code from the list below or enter NULL",! D G FIND1 ; "RTN","SDECSTSQ",56,0) . S FIELDS=$P(^DD(2.98,3,0),U,3) ; "RTN","SDECSTSQ",57,0) . F I=1:1 S FIELD=$P(FIELDS,";",I) Q:FIELD="" W $P(FIELD,":",1)," - ",$P(FIELD,":",2),! ; "RTN","SDECSTSQ",58,0) ; "RTN","SDECSTSQ",59,0) I X="NULL" S PTSTATUS=X ; "RTN","SDECSTSQ",60,0) E I $$SETCODES^SDECSTSR(2.98,3,X)="" W " ???" G FIND1 ; "RTN","SDECSTSQ",61,0) I X'="NULL" W " - ",$$SETCODES^SDECSTSR(2.98,3,X) S PTSTATUS=X ; "RTN","SDECSTSQ",62,0) FIND2 ; "RTN","SDECSTSQ",63,0) R !,"Select encounter status: ",X:$S($G(DTIME):DTIME,1:300) Q:'$T Q:X="" Q:X="^" ; "RTN","SDECSTSQ",64,0) I X="?" W !!,"Enter a status from the list below or enter NULL or NONE",! D G FIND2 ; "RTN","SDECSTSQ",65,0) . S X="" F S X=$O(^SD(409.63,"B",X)) Q:X="" W X,! ; "RTN","SDECSTSQ",66,0) ; "RTN","SDECSTSQ",67,0) I X="NULL"!(X="NONE") S ENCSTATUS=X G FIND3 ; "RTN","SDECSTSQ",68,0) S DIC=409.63,DIC(0)="EQM" D ^DIC Q:Y<0 S ENCSTATUS=+Y ; "RTN","SDECSTSQ",69,0) FIND3 ; "RTN","SDECSTSQ",70,0) R !,"Select appointment file status: ",X:$S($G(DTIME):DTIME,1:300) Q:'$T Q:X="" Q:X="^" ; "RTN","SDECSTSQ",71,0) I X="?" W !!,"Enter a code from the list below or enter NONE or NULL",! D G FIND3 ; "RTN","SDECSTSQ",72,0) . S FIELDS=$P(^DD(409.84,.17,0),U,3) ; "RTN","SDECSTSQ",73,0) . F I=1:1 S FIELD=$P(FIELDS,";",I) Q:FIELD="" W $P(FIELD,":",1)," - ",$P(FIELD,":",2),! ; "RTN","SDECSTSQ",74,0) ; "RTN","SDECSTSQ",75,0) I X="NULL"!(X="NONE") S APPTSTATUS=X ; "RTN","SDECSTSQ",76,0) E I $$SETCODES^SDECSTSR(409.84,.17,X)="" W " ???" G FIND3 ; "RTN","SDECSTSQ",77,0) I X'="NULL",X'="NONE" W " - ",$$SETCODES^SDECSTSR(409.84,.17,X) S APPTSTATUS=X ; "RTN","SDECSTSQ",78,0) ; "RTN","SDECSTSQ",79,0) ; If report is queued, add to Taskman "RTN","SDECSTSQ",80,0) ; "RTN","SDECSTSQ",81,0) I REPORT="YES",$D(IO("Q")) D Q ; "RTN","SDECSTSQ",82,0) . S ZTRTN="FIND4^SDECSTSQ",ZTDESC="Appointment-Encounter-Appointment Status Report" ; "RTN","SDECSTSQ",83,0) . S ZTSAVE("*")="" ; "RTN","SDECSTSQ",84,0) . D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! K ZTDESC,ZTRTN,ZTSAVE,ZTSK ; "RTN","SDECSTSQ",85,0) ; "RTN","SDECSTSQ",86,0) FIND4 ; Entry point for queued report printing "RTN","SDECSTSQ",87,0) ; "RTN","SDECSTSQ",88,0) ; Scan patient file in name order. Only process patient file entries that have appointments after the selected start date. "RTN","SDECSTSQ",89,0) ; "RTN","SDECSTSQ",90,0) U:REPORT="YES" IO W ! S NAME="",COUNT=0 ; "RTN","SDECSTSQ",91,0) F S NAME=$O(^DPT("B",NAME)) Q:NAME="" S DFN=0 F S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN I $O(^DPT(DFN,"S",START))>0 D ; "RTN","SDECSTSQ",92,0) . ; "RTN","SDECSTSQ",93,0) . ; Get status from patient file. "RTN","SDECSTSQ",94,0) . ; "RTN","SDECSTSQ",95,0) . S DTTM=START F S DTTM=$O(^DPT(DFN,"S",DTTM)) Q:'DTTM S PTDATA=^(DTTM,0) D ; ICR #7030 "RTN","SDECSTSQ",96,0) .. ; "RTN","SDECSTSQ",97,0) .. ; Skip appointments that do not match the selected status. "RTN","SDECSTSQ",98,0) .. ; "RTN","SDECSTSQ",99,0) .. I PTSTATUS="NULL" Q:$P(PTDATA,U,2)'="" ; "RTN","SDECSTSQ",100,0) .. E I $P(PTDATA,U,2)'=PTSTATUS Q ; "RTN","SDECSTSQ",101,0) .. ; "RTN","SDECSTSQ",102,0) .. ; Get status of encounter from file. "RTN","SDECSTSQ",103,0) .. ; "RTN","SDECSTSQ",104,0) .. S ENCOUNTER=$P(PTDATA,U,20),ENCDATA=$S(ENCOUNTER:$G(^SCE(ENCOUNTER,0)),1:"") ; "RTN","SDECSTSQ",105,0) .. ; "RTN","SDECSTSQ",106,0) .. ; Skip encounters that do not match the selected status. "RTN","SDECSTSQ",107,0) .. ; "RTN","SDECSTSQ",108,0) .. I ENCSTATUS="NULL" Q:$P(ENCDATA,U,12)'="" ; "RTN","SDECSTSQ",109,0) .. I ENCSTATUS="NONE" Q:ENCOUNTER ; "RTN","SDECSTSQ",110,0) .. I ENCSTATUS'="NULL",ENCSTATUS'="NONE" Q:$P(ENCDATA,U,12)'=ENCSTATUS ; "RTN","SDECSTSQ",111,0) .. ; "RTN","SDECSTSQ",112,0) .. ; Scan appointment file for the patient and appointment date/time. Get status from appointment file "RTN","SDECSTSQ",113,0) .. ; "RTN","SDECSTSQ",114,0) .. S APPTIEN=0,FIRST=1 F S APPTIEN=$O(^SDEC(409.84,"APTDT",DFN,DTTM,APPTIEN)) Q:'APPTIEN S APPTDATA=$G(^SDEC(409.84,APPTIEN,0)) D ; "RTN","SDECSTSQ",115,0) ... ; "RTN","SDECSTSQ",116,0) ... ; Skip encounters that do not match the selected status. "RTN","SDECSTSQ",117,0) ... ; "RTN","SDECSTSQ",118,0) ... I APPTSTATUS="NULL" Q:$P(APPTDATA,U,17)'="" ; "RTN","SDECSTSQ",119,0) ... I APPTSTATUS'="NULL" Q:$P(APPTDATA,U,17)'=APPTSTATUS ; "RTN","SDECSTSQ",120,0) ... ; "RTN","SDECSTSQ",121,0) ... ; Show patient and encounter data if this is the first matching appointment from the appointment file. "RTN","SDECSTSQ",122,0) ... ; "RTN","SDECSTSQ",123,0) ... I FIRST D LINE,SHOWPAT^SDECSTSR(DFN,DTTM),SHOWENC^SDECSTSR(ENCOUNTER) S FIRST=0 ; "RTN","SDECSTSQ",124,0) ... ; "RTN","SDECSTSQ",125,0) ... ; Show appointment data. "RTN","SDECSTSQ",126,0) ... ; "RTN","SDECSTSQ",127,0) ... D SHOWAPPT^SDECSTSR(APPTIEN) S COUNT=COUNT+1 ; "RTN","SDECSTSQ",128,0) .. ; "RTN","SDECSTSQ",129,0) .. ; If no matching appointment was found in the appointment file and NONE was selected for appointments, display patient and encounter data. "RTN","SDECSTSQ",130,0) .. ; "RTN","SDECSTSQ",131,0) .. I FIRST,APPTSTATUS="NONE" D Q ; "RTN","SDECSTSQ",132,0) ... D LINE,SHOWPAT^SDECSTSR(DFN,DTTM),SHOWENC^SDECSTSR(ENCOUNTER),SHOWAPPT^SDECSTSR("") S COUNT=COUNT+1 ; "RTN","SDECSTSQ",133,0) ; "RTN","SDECSTSQ",134,0) I REPORT="YES" D ^%ZISC K ZTDESC,ZTRTN,ZTSAVE,ZTSK ; "RTN","SDECSTSQ",135,0) ; "RTN","SDECSTSQ",136,0) Q ; "RTN","SDECSTSQ",137,0) ; "RTN","SDECSTSQ",138,0) LINE ; "RTN","SDECSTSQ",139,0) ; "RTN","SDECSTSQ",140,0) W "-------------------------------------------------------------------------------",! ; "RTN","SDECSTSQ",141,0) Q ; "RTN","SDECSTSQ",142,0) ; "RTN","SDECSTSR") 0^2^B57183153^n/a "RTN","SDECSTSR",1,0) SDECSTSR ; ALB/WTC - VISTA SCHEDULING GUI; 21 Aug 2019 7:10 AM ; 13 Nov 2019 9:28 AM "RTN","SDECSTSR",2,0) ;;5.3;Scheduling;**737**;;Build 13 "RTN","SDECSTSR",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","SDECSTSR",4,0) Q "RTN","SDECSTSR",5,0) ; "RTN","SDECSTSR",6,0) ; Report and fix appointment-encounter-appointment status triples from, respectively, the patient file (#2), the encounter file (#409.68) and "RTN","SDECSTSR",7,0) ; the appointment file (#409.84). "RTN","SDECSTSR",8,0) ; "RTN","SDECSTSR",9,0) ; Distinguish encounter status from before and after installation of patch 722 - 9/11/2019 "RTN","SDECSTSR",10,0) ; "RTN","SDECSTSR",11,0) ; ICR "RTN","SDECSTSR",12,0) ; --- "RTN","SDECSTSR",13,0) ; 7030 - #2 patient appointment data "RTN","SDECSTSR",14,0) ; "RTN","SDECSTSR",15,0) DOWNLOAD ; "RTN","SDECSTSR",16,0) ; "RTN","SDECSTSR",17,0) ; Generate summary of appointment-encounter-appointment triples in comma-delimited format that can be uploaded to Excel. "RTN","SDECSTSR",18,0) ; "RTN","SDECSTSR",19,0) ; NOTE: This download is an analysis tool run by programmers. It is not linked to an option. "RTN","SDECSTSR",20,0) ; "RTN","SDECSTSR",21,0) W !!,"Generate summary of patient appointment-encounter-appointment file status triples in comma delimited format",! ; "RTN","SDECSTSR",22,0) ; "RTN","SDECSTSR",23,0) N TYPE S TYPE="DOWNLOAD" G SUMMARY1 ; "RTN","SDECSTSR",24,0) ; "RTN","SDECSTSR",25,0) SUMMARY ; "RTN","SDECSTSR",26,0) ; "RTN","SDECSTSR",27,0) ; Generate summary of appointment-encounter-appointment triples in report format. "RTN","SDECSTSR",28,0) ; "RTN","SDECSTSR",29,0) ; NOTE: This report is an analysis tool run by programmers. It is not linked to an option. "RTN","SDECSTSR",30,0) ; "RTN","SDECSTSR",31,0) W !!,"Generate summary of patient appointment-encounter-appointment file status triples in report format",! ; "RTN","SDECSTSR",32,0) ; "RTN","SDECSTSR",33,0) N TYPE S TYPE="REPORT" ; "RTN","SDECSTSR",34,0) ; "RTN","SDECSTSR",35,0) SUMMARY1 ; "RTN","SDECSTSR",36,0) ; "RTN","SDECSTSR",37,0) N %DT,START,Y,NAME,DFN,DTTM,PTDATA,PTSTATUS,ENCOUNTER,ENCDATA,ENCSTATUS,APPTDATA,APPTSTATUS,FOUND,I ; "RTN","SDECSTSR",38,0) N PATCH,ENCDATE,LASTDATE ; "RTN","SDECSTSR",39,0) ; "RTN","SDECSTSR",40,0) ; Determine date that patch 722 was installed. "RTN","SDECSTSR",41,0) ; "RTN","SDECSTSR",42,0) S PATCH=$$PATCH(722) ; "RTN","SDECSTSR",43,0) ; "RTN","SDECSTSR",44,0) ; Do not look at encounters that are less than a week old. "RTN","SDECSTSR",45,0) ; "RTN","SDECSTSR",46,0) S LASTDATE=$P($$FMADD^XLFDT($$NOW^XLFDT(),-7),".",1) ; "RTN","SDECSTSR",47,0) ; "RTN","SDECSTSR",48,0) ; Scan is in date order starting with the user indicated date. "RTN","SDECSTSR",49,0) ; "RTN","SDECSTSR",50,0) W !,"Select appointment starting date",! ; "RTN","SDECSTSR",51,0) S %DT="AX" D ^%DT Q:Y<0 S START=$P(Y,".",1) W ! ; "RTN","SDECSTSR",52,0) ; "RTN","SDECSTSR",53,0) K ^TMP($J) ; "RTN","SDECSTSR",54,0) ; "RTN","SDECSTSR",55,0) ; Scan patient file in alphabetic order. Process patients that have appointments after the selected start date. "RTN","SDECSTSR",56,0) ; "RTN","SDECSTSR",57,0) S NAME="" F I=1:1 S NAME=$O(^DPT("B",NAME)) Q:NAME="" S DFN=0 F S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN W:I#1000=0 "." I $O(^DPT(DFN,"S",START))>0 D ; "RTN","SDECSTSR",58,0) . ; "RTN","SDECSTSR",59,0) . ; Scan patient's appointments. "RTN","SDECSTSR",60,0) . ; "RTN","SDECSTSR",61,0) . S DTTM=START F S DTTM=$O(^DPT(DFN,"S",DTTM)) Q:'DTTM Q:DTTM>LASTDATE S PTDATA=^(DTTM,0) D ; ICR #7030 "RTN","SDECSTSR",62,0) .. ; "RTN","SDECSTSR",63,0) .. ; Get status of appointment in patient file. "RTN","SDECSTSR",64,0) .. ; "RTN","SDECSTSR",65,0) .. S PTSTATUS=$S($P(PTDATA,U,2)'="":$$SETCODES(2.98,3,$P(PTDATA,U,2)),1:"null") ; ICR #7030 "RTN","SDECSTSR",66,0) .. ; "RTN","SDECSTSR",67,0) .. ; Get encounter from patient's appointment record and the status of the encounter from file. "RTN","SDECSTSR",68,0) .. ; "RTN","SDECSTSR",69,0) .. S ENCOUNTER=$P(PTDATA,U,20),ENCSTATUS=$S(ENCOUNTER:$P($G(^SCE(ENCOUNTER,0)),U,12),1:""),ENCSTATUS=$S(ENCOUNTER="":"NONE",ENCSTATUS="":"null",1:$$GET1^DIQ(409.63,ENCSTATUS_",",.01)) ; "RTN","SDECSTSR",70,0) .. ; "RTN","SDECSTSR",71,0) .. ; Flag encounter status as BEFORE or AFTER patch 722 installation. "RTN","SDECSTSR",72,0) .. ; "RTN","SDECSTSR",73,0) .. I ENCSTATUS'="NONE" S ENCDATE=$P($G(^SCE(ENCOUNTER,"USER")),U,4),ENCSTATUS=ENCSTATUS_"-"_$S(ENCDATE="":"NO DATE",ENCDATE