SDES929P ;ALB/BLB,LAB - SD*5.3*929 Post Init Routine ; Jan 30, 2026
;;5.3;SCHEDULING;**929**;AUG 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;;
Q
;
EN ;
D TASK
Q
;
;
TASK ; tasks off process to update the direct patient schedule field in the hospital location file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*929 Post-Install to create utilization report for off hour clinics.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*929 Post Install Routine Task 1"
D NOW^%DTC
S ZTDTH=$P($H,",",1)_","_86399,ZTIO="",ZTRTN="REPORT^SDES929P",ZTSAVE("*")=""
D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
REPORT ;
N COUNT,STOPCODEIEN,CLINICCOUNT,ISSUECOUNT,STOPCODE,CLINICIEN,SLOTCOUNT,SLOTSTART,CURRENTSLOTS,DATE,TIME
N DAYOFTHEWEEK,SCHEDULEDATE,SUBIEN,ORIGINALSLOTS,APPTSUBIEN,APPTCOUNT,FOUND,SLOTDATETIME
K ^XTMP("SDES929P")
S ^XTMP("SDES929P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*929"
S ^XTMP("SDES929P",1)="**********************************SLOT REPORT**********************************"
S COUNT=4
S ^XTMP("SDES929P",COUNT)="Clinic IEN^Clinic Name^Slot Date Time^Appointment Count^Original Count^Current Count"
S COUNT=COUNT+1
S STOPCODEIEN=0,CLINICCOUNT=0,ISSUECOUNT=0
F STOPCODE=342,303,502 D
.S STOPCODEIEN=$O(^DIC(40.7,"C",STOPCODE,""))
.;
.S CLINICIEN=0
.F S CLINICIEN=$O(^SC("AST",STOPCODEIEN,CLINICIEN)) Q:'CLINICIEN D
..S CLINICCOUNT=CLINICCOUNT+1
..;
..K @$NA(^TMP($J,"SLOTSEARCH"))
..D GETSLOTS^SDEC57($NA(^TMP($J,"SLOTSEARCH")),$$GETRES^SDES2UTIL1(CLINICIEN),$$FMADD^XLFDT(DT-365),$$FMADD^XLFDT(DT,390))
..;
..S SLOTCOUNT=0
..F S SLOTCOUNT=$O(^TMP($J,"SLOTSEARCH",SLOTCOUNT)) Q:'SLOTCOUNT D
...;
...S SLOTSTART=+$P($G(^TMP($J,"SLOTSEARCH",SLOTCOUNT)),U,2)
...S CURRENTSLOTS=$P($G(^TMP($J,"SLOTSEARCH",SLOTCOUNT)),U,4)
...I CURRENTSLOTS?1A S CURRENTSLOTS=$F("abcdefghijklmnopqrstuvwxyz",CURRENTSLOTS)-1
...S DATE=$P(SLOTSTART,".")
...;quit if holiday and clinic doesn't meet on holiday
...Q:$D(^HOLIDAY(DATE,0))&($$GET1^DIQ(44,CLINICIEN,1918.5,"E")'="YES")
...Q:$G(^SC(CLINICIEN,"ST",DATE,1))["CANCELLED"
...Q:CURRENTSLOTS="X" ;cancelled time slot
...S TIME=$E(SLOTSTART,8,$L(SLOTSTART))
...S DAYOFTHEWEEK=$$DOW^XLFDT(DATE)
...S SCHEDULEDATE=$S('$D(^SC(CLINICIEN,"T",DATE)):$$GETINDEFSLOTDATE(CLINICIEN,$$FMADD^XLFDT(DATE,1),"T"_$$UP^XLFSTR($$DOW^XLFDT(DATE,1))),1:DATE)
...;
...I $$INACTIVE^SDES2UTIL(CLINICIEN,DATE) Q
...I 'SCHEDULEDATE Q
...;
...S SUBIEN=0,SLOTDATETIME=0,FOUND=0
...F S SUBIEN=$O(^SC(CLINICIEN,"T",SCHEDULEDATE,2,SUBIEN)) Q:'SUBIEN!(FOUND=1) D
....I SLOTSTART=$$HTFM^XLFDT($$FMTH^XLFDT(DATE_"."_$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINICIEN_",",.01,"I"))) D
.....;
.....S ORIGINALSLOTS=$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINICIEN_",",1,"I")
.....;
.....S APPTSUBIEN=0,APPTCOUNT=0
.....F S APPTSUBIEN=$O(^SC(CLINICIEN,"S",SLOTSTART,1,APPTSUBIEN)) Q:'APPTSUBIEN D
......S:($$GET1^DIQ(44.003,APPTSUBIEN_","_SLOTSTART_","_CLINICIEN_",",310,"I")'="C") APPTCOUNT=APPTCOUNT+1
.....;
.....I (APPTCOUNT>0)&(APPTCOUNT'=(ORIGINALSLOTS-CURRENTSLOTS)) D
......S ISSUECOUNT=ISSUECOUNT+1
......;
......S ^XTMP("SDES929P",COUNT)=CLINICIEN_U_$$GET1^DIQ(44,CLINICIEN,.01)_U_$$FMTISO^SDAMUTDT(SLOTSTART)
......S ^XTMP("SDES929P",COUNT)=^XTMP("SDES929P",COUNT)_U_APPTCOUNT_U_ORIGINALSLOTS_U_CURRENTSLOTS
......S COUNT=COUNT+1
......S FOUND=1
S ^XTMP("SDES929P",2)="Total Number of Clinics Searched : "_CLINICCOUNT
S COUNT=COUNT+1
S ^XTMP("SDES929P",3)="Total Number of Issues Found : "_ISSUECOUNT
;
D MAIL
K ^XTMP("SDES929P")
Q
;
MAIL ;
N STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MESS1="Station: "_STANUM_" - "
S XMDUZ=DUZ
S XMTEXT="^XTMP(""SDES929P"","
S XMSUB=MESS1_"SD*5.3*929 - Post Install Data Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
S XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
S XMY("BUTLER.BRANDON@DOMAIN.EXT")=""
D ^XMD
Q
;
GETINDEFSLOTDATE(CLINICIEN,DATE,TNODE) ;
N TDATE,INDEFDATE
;
S INDEFDATE=0
F S DATE=$O(^SC(CLINICIEN,"T",DATE),-1) Q:'DATE!($G(INDEFDATE)) D
.I $$DOW^XLFDT(DATE,1)=$E(TNODE,2) D
..I $D(^SC(CLINICIEN,"OST",DATE)) Q
..S INDEFDATE=DATE
Q INDEFDATE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES929P 4681 printed Apr 22, 2026@14:53:36 Page 2
SDES929P ;ALB/BLB,LAB - SD*5.3*929 Post Init Routine ; Jan 30, 2026
+1 ;;5.3;SCHEDULING;**929**;AUG 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;;
+4 QUIT
+5 ;
EN ;
+1 DO TASK
+2 QUIT
+3 ;
+4 ;
TASK ; tasks off process to update the direct patient schedule field in the hospital location file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*929 Post-Install to create utilization report for off hour clinics.")
+3 DO MES^XPDUTL("")
+4 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+5 SET ZTDESC="SD*5.3*929 Post Install Routine Task 1"
+6 DO NOW^%DTC
+7 SET ZTDTH=$PIECE($HOROLOG,",",1)_","_86399
SET ZTIO=""
SET ZTRTN="REPORT^SDES929P"
SET ZTSAVE("*")=""
+8 DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
REPORT ;
+1 NEW COUNT,STOPCODEIEN,CLINICCOUNT,ISSUECOUNT,STOPCODE,CLINICIEN,SLOTCOUNT,SLOTSTART,CURRENTSLOTS,DATE,TIME
+2 NEW DAYOFTHEWEEK,SCHEDULEDATE,SUBIEN,ORIGINALSLOTS,APPTSUBIEN,APPTCOUNT,FOUND,SLOTDATETIME
+3 KILL ^XTMP("SDES929P")
+4 SET ^XTMP("SDES929P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*929"
+5 SET ^XTMP("SDES929P",1)="**********************************SLOT REPORT**********************************"
+6 SET COUNT=4
+7 SET ^XTMP("SDES929P",COUNT)="Clinic IEN^Clinic Name^Slot Date Time^Appointment Count^Original Count^Current Count"
+8 SET COUNT=COUNT+1
+9 SET STOPCODEIEN=0
SET CLINICCOUNT=0
SET ISSUECOUNT=0
+10 FOR STOPCODE=342,303,502
Begin DoDot:1
+11 SET STOPCODEIEN=$ORDER(^DIC(40.7,"C",STOPCODE,""))
+12 ;
+13 SET CLINICIEN=0
+14 FOR
SET CLINICIEN=$ORDER(^SC("AST",STOPCODEIEN,CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:2
+15 SET CLINICCOUNT=CLINICCOUNT+1
+16 ;
+17 KILL @$NAME(^TMP($JOB,"SLOTSEARCH"))
+18 DO GETSLOTS^SDEC57($NAME(^TMP($JOB,"SLOTSEARCH")),$$GETRES^SDES2UTIL1(CLINICIEN),$$FMADD^XLFDT(DT-365),$$FMADD^XLFDT(DT,390))
+19 ;
+20 SET SLOTCOUNT=0
+21 FOR
SET SLOTCOUNT=$ORDER(^TMP($JOB,"SLOTSEARCH",SLOTCOUNT))
if 'SLOTCOUNT
QUIT
Begin DoDot:3
+22 ;
+23 SET SLOTSTART=+$PIECE($GET(^TMP($JOB,"SLOTSEARCH",SLOTCOUNT)),U,2)
+24 SET CURRENTSLOTS=$PIECE($GET(^TMP($JOB,"SLOTSEARCH",SLOTCOUNT)),U,4)
+25 IF CURRENTSLOTS?1A
SET CURRENTSLOTS=$FIND("abcdefghijklmnopqrstuvwxyz",CURRENTSLOTS)-1
+26 SET DATE=$PIECE(SLOTSTART,".")
+27 ;quit if holiday and clinic doesn't meet on holiday
+28 if $DATA(^HOLIDAY(DATE,0))&($$GET1^DIQ(44,CLINICIEN,1918.5,"E")'="YES")
QUIT
+29 if $GET(^SC(CLINICIEN,"ST",DATE,1))["CANCELLED"
QUIT
+30 ;cancelled time slot
if CURRENTSLOTS="X"
QUIT
+31 SET TIME=$EXTRACT(SLOTSTART,8,$LENGTH(SLOTSTART))
+32 SET DAYOFTHEWEEK=$$DOW^XLFDT(DATE)
+33 SET SCHEDULEDATE=$SELECT('$DATA(^SC(CLINICIEN,"T",DATE)):$$GETINDEFSLOTDATE(CLINICIEN,$$FMADD^XLFDT(DATE,1),"T"_$$UP^XLFSTR($$DOW^XLFDT(DATE,1))),1:DATE)
+34 ;
+35 IF $$INACTIVE^SDES2UTIL(CLINICIEN,DATE)
QUIT
+36 IF 'SCHEDULEDATE
QUIT
+37 ;
+38 SET SUBIEN=0
SET SLOTDATETIME=0
SET FOUND=0
+39 FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"T",SCHEDULEDATE,2,SUBIEN))
if 'SUBIEN!(FOUND=1)
QUIT
Begin DoDot:4
+40 IF SLOTSTART=$$HTFM^XLFDT($$FMTH^XLFDT(DATE_"."_$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINICIEN_",",.01,"I")))
Begin DoDot:5
+41 ;
+42 SET ORIGINALSLOTS=$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINICIEN_",",1,"I")
+43 ;
+44 SET APPTSUBIEN=0
SET APPTCOUNT=0
+45 FOR
SET APPTSUBIEN=$ORDER(^SC(CLINICIEN,"S",SLOTSTART,1,APPTSUBIEN))
if 'APPTSUBIEN
QUIT
Begin DoDot:6
+46 if ($$GET1^DIQ(44.003,APPTSUBIEN_","_SLOTSTART_","_CLINICIEN_",",310,"I")'="C")
SET APPTCOUNT=APPTCOUNT+1
End DoDot:6
+47 ;
+48 IF (APPTCOUNT>0)&(APPTCOUNT'=(ORIGINALSLOTS-CURRENTSLOTS))
Begin DoDot:6
+49 SET ISSUECOUNT=ISSUECOUNT+1
+50 ;
+51 SET ^XTMP("SDES929P",COUNT)=CLINICIEN_U_$$GET1^DIQ(44,CLINICIEN,.01)_U_$$FMTISO^SDAMUTDT(SLOTSTART)
+52 SET ^XTMP("SDES929P",COUNT)=^XTMP("SDES929P",COUNT)_U_APPTCOUNT_U_ORIGINALSLOTS_U_CURRENTSLOTS
+53 SET COUNT=COUNT+1
+54 SET FOUND=1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+55 SET ^XTMP("SDES929P",2)="Total Number of Clinics Searched : "_CLINICCOUNT
+56 SET COUNT=COUNT+1
+57 SET ^XTMP("SDES929P",3)="Total Number of Issues Found : "_ISSUECOUNT
+58 ;
+59 DO MAIL
+60 KILL ^XTMP("SDES929P")
+61 QUIT
+62 ;
MAIL ;
+1 NEW STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ
+2 SET STANUM=$$KSP^XUPARAM("INST")_","
+3 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+4 SET MESS1="Station: "_STANUM_" - "
+5 SET XMDUZ=DUZ
+6 SET XMTEXT="^XTMP(""SDES929P"","
+7 SET XMSUB=MESS1_"SD*5.3*929 - Post Install Data Report"
+8 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+9 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+10 SET XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
+11 SET XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
+12 SET XMY("BUTLER.BRANDON@DOMAIN.EXT")=""
+13 DO ^XMD
+14 QUIT
+15 ;
GETINDEFSLOTDATE(CLINICIEN,DATE,TNODE) ;
+1 NEW TDATE,INDEFDATE
+2 ;
+3 SET INDEFDATE=0
+4 FOR
SET DATE=$ORDER(^SC(CLINICIEN,"T",DATE),-1)
if 'DATE!($GET(INDEFDATE))
QUIT
Begin DoDot:1
+5 IF $$DOW^XLFDT(DATE,1)=$EXTRACT(TNODE,2)
Begin DoDot:2
+6 IF $DATA(^SC(CLINICIEN,"OST",DATE))
QUIT
+7 SET INDEFDATE=DATE
End DoDot:2
End DoDot:1
+8 QUIT INDEFDATE
+9 ;
