SDES950P ;ALB/LAB,JHC - SD*5.3*950 Post Init Routine ; Jul 08, 2026
;;5.3;SCHEDULING;**950**;AUG 13, 1993;Build 6
;;Per VHA Directive 6402, this routine should not be modified
;;
Q
;
EN ;
D TASK,TASK2,TASK3
Q
;
TASK ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*950 Post-Install to identify clinics with slot decrement issues")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE,%,%H,%I
S ZTDESC="SD*5.3*950 Post Install Routine Task 1"
D NOW^%DTC
S ZTDTH=$P($H,",",1)_","_86399,ZTIO="",ZTRTN="REPORT^SDES950P",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,CLINIEN,SLOTCOUNT,SLOTSTART,CURRENTSLOTS,DATE,TIME
N DAYOFTHEWEEK,SCHEDULEDATE,SUBIEN,ORIGINALSLOTS,APPTSUBIEN,APPTCOUNT,FOUND,SLOTDATETIME,DFN,DFNLIST,%,%DT,I
K ^XTMP("SDES950P")
S ^XTMP("SDES950P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*950"
S ^XTMP("SDES950P",1)="**********************************SLOT REPORT**********************************"
S COUNT=4
S ^XTMP("SDES950P",COUNT)="Clinic IEN^Clinic Name^Slot Date Time^Appointment Count^Original Count^Current Count^Patient DFN*Appointment IEN (|list)"
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 CLINIEN=0
.F S CLINIEN=$O(^SC("AST",STOPCODEIEN,CLINIEN)) Q:'CLINIEN D
..S CLINICCOUNT=CLINICCOUNT+1
..K @$NA(^TMP($J,"SLOTSEARCH"))
..D GETSLOTS^SDEC57($NA(^TMP($J,"SLOTSEARCH")),$$GETRES^SDES2UTIL1(CLINIEN),$$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,CLINIEN,1918.5,"E")'="YES")
...Q:$G(^SC(CLINIEN,"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(CLINIEN,"T",DATE)):$$GETINDEFSLOTDATE(CLINIEN,$$FMADD^XLFDT(DATE,1),"T"_$$UP^XLFSTR($$DOW^XLFDT(DATE,1))),1:DATE)
...Q:$$INACTIVE^SDES2UTIL(CLINIEN,DATE)
...Q:'(SCHEDULEDATE)
...S SUBIEN=0,SLOTDATETIME=0,FOUND=0
...F S SUBIEN=$O(^SC(CLINIEN,"T",SCHEDULEDATE,2,SUBIEN)) Q:'SUBIEN!(FOUND=1) D
....I SLOTSTART=$$HTFM^XLFDT($$FMTH^XLFDT(DATE_"."_$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINIEN_",",.01,"I"))) D
.....S ORIGINALSLOTS=$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINIEN_",",1,"I")
.....S APPTSUBIEN=0,APPTCOUNT=0
.....S DFNLIST=""
.....F S APPTSUBIEN=$O(^SC(CLINIEN,"S",SLOTSTART,1,APPTSUBIEN)) Q:'APPTSUBIEN D
......I $$GET1^DIQ(44.003,APPTSUBIEN_","_SLOTSTART_","_CLINIEN_",",310,"I")'="C" D
.......S APPTCOUNT=APPTCOUNT+1
.......S DFN=$$GET1^DIQ(44.003,APPTSUBIEN_","_SLOTSTART_","_CLINIEN_",",.01,"I")
.......S DFNLIST=DFNLIST_DFN_"*"_$O(^SDEC(409.84,"APTDT",DFN,SLOTSTART,""),-1)_"|"
.....I (APPTCOUNT>0)&((ORIGINALSLOTS-APPTCOUNT)<CURRENTSLOTS) D
......S ISSUECOUNT=ISSUECOUNT+1
......S ^XTMP("SDES950P",COUNT)=CLINIEN_U_$$GET1^DIQ(44,CLINIEN,.01)_U_$$FMTISO^SDAMUTDT(SLOTSTART)
......S ^XTMP("SDES950P",COUNT)=^XTMP("SDES950P",COUNT)_U_APPTCOUNT_U_ORIGINALSLOTS_U_CURRENTSLOTS_U_DFNLIST
......S COUNT=COUNT+1
......S FOUND=1
S ^XTMP("SDES950P",2)="Total Number of Clinics Searched : "_CLINICCOUNT
S COUNT=COUNT+1
S ^XTMP("SDES950P",3)="Total Number of Issues Found : "_ISSUECOUNT
;
D MAIL
Q
;
MAIL ;
N SITENUMBER,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ,PROD
S SITENUMBER=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
S PROD=$$PROD^XUPROD
S MESS1="Station: "_SITENUMBER_" ("_$S(PROD:"PROD",1:"TEST")_") - "
S XMDUZ=DUZ
S XMTEXT="^XTMP(""SDES950P"","
S XMSUB=MESS1_"SD*5.3*950 - Post Install Data Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
I 'PROD D
. S XMY("BARBER.LORI@DOMAIN.EXT")=""
I PROD D
. S XMY("BARBER.LORI@DOMAIN.EXT")=""
. S XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
. S XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
D ^XMD
Q
;
GETINDEFSLOTDATE(CLINIEN,DATE,TNODE) ;
N TDATE,INDEFDATE
;
S INDEFDATE=0
F S DATE=$O(^SC(CLINIEN,"T",DATE),-1) Q:'DATE!($G(INDEFDATE)) D
.I $$DOW^XLFDT(DATE,1)=$E(TNODE,2) D
..I $D(^SC(CLINIEN,"OST",DATE)) Q
..S INDEFDATE=DATE
Q INDEFDATE
;
TASK2 ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*950 Post-Install to create report of instances of ghost availability.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*950 Post Install Routine Task 2"
D NOW^%DTC
S ZTDTH=$P($H,",",1)_","_86399,ZTIO="",ZTRTN="REPORT2^SDES950P",ZTSAVE("*")=""
D ^%ZTLOAD
I $D(ZTSK) D Q
. 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
;
REPORT2 ;
N CREATEDT,UPDATECNT
K ^XTMP("SDES950P-2")
S ^XTMP("SDES950P-2",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*950"
S UPDATECNT=1
S UPDATECNT=UPDATECNT+1
;
D IDENTIFYGHOST
;
D MAIL2
Q
;
MAIL2 ;
N SITENUMBER,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ,PROD
S SITENUMBER=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
S PROD=$$PROD^XUPROD
S MESS1="Station: "_SITENUMBER_" ("_$S(PROD:"PROD",1:"TEST")_") - "
S XMDUZ=DUZ
S XMTEXT="^XTMP(""SDES950P-2"","
S XMSUB=MESS1_"SD*5.3*950 - Ghost Availability Data Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("BUTLER.BRANDON@DOMAIN.EXT")=""
S XMY("SWESKY.JEFFREY@DOMAIN.EXT")=""
I PROD D
. S XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
. S XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
D ^XMD
Q
;
IDENTIFYGHOST() ;
N CLINIEN,GHOST,CLINIEN,CLINICNAME,COUNT,NONSTDDATE,INDEFDATE,STARTDATE,ORPHANDATE
;
S CLINIEN=0
F S CLINIEN=$O(^SC(CLINIEN)) Q:'CLINIEN D
.I $$INACTIVE^SDESUTIL(CLINIEN) Q
.S STARTDATE=$$FMADD^XLFDT(DT,-$$GET1^DIQ(44,CLINIEN,2002))
.D INDEFOVERWRITES(.GHOST,CLINIEN,STARTDATE)
.D ORPHANEDOSTDAYS(.GHOST,CLINIEN)
;
K ^XTMP("SDES950P-2")
S COUNT=1
S ^XTMP("SDES950P-2",COUNT)="**********************************GHOST AVAILABILITY REPORT**********************************"
S COUNT=COUNT+1
S ^XTMP("SDES950P-2",COUNT)="CLINIC^ISSUE DESCRIPTION^DATE"
;
S CLINIEN=0
F S CLINIEN=$O(GHOST(CLINIEN)),CLINICNAME=$$GET1^DIQ(44,CLINIEN,.01) Q:'CLINIEN D
.S INDEFDATE=0
.F S INDEFDATE=$O(GHOST(CLINIEN,"INDEFINITE OVERWRITE",INDEFDATE)) Q:'INDEFDATE D
..S COUNT=COUNT+1
..S ^XTMP("SDES950P-2",COUNT)=CLINICNAME_U
..S ^XTMP("SDES950P-2",COUNT)=^XTMP("SDES950P-2",COUNT)_"Indefinite Availability is overlaid with Special Availability"_U_$$FMTISO^SDAMUTDT(INDEFDATE)
.S ORPHANDATE=0
.F S ORPHANDATE=$O(GHOST(CLINIEN,"ORPHANED OST",ORPHANDATE)) Q:'ORPHANDATE D
..S COUNT=COUNT+1
..S ^XTMP("SDES950P-2",COUNT)=CLINICNAME_U
..S ^XTMP("SDES950P-2",COUNT)=^XTMP("SDES950P-2",COUNT)_"Unable to define precise time for special availability defined"_U_$$FMTISO^SDAMUTDT(ORPHANDATE)
;
Q
;
INDEFOVERWRITES(GHOST,CLINIEN,DATE) ;
N TNODE
;
F TNODE=0:1:6 I $D(^SC(CLINIEN,"T"_TNODE)) D
.I $O(^SC(CLINIEN,"T"_TNODE,0))=9999999,$D(^SC(CLINIEN,"OST")) D Q
..S DATE=$$FMADD^XLFDT(DT,-14)
..F S DATE=$O(^SC(CLINIEN,"OST",DATE)) Q:'DATE D
...Q:'$D(^SC(CLINIEN,"OST",DATE,1))
...Q:^SC(CLINIEN,"OST",DATE,1)'["["
...I TNODE=($$FMTH^XLFDT(DATE)+4#7) D
....S GHOST(CLINIEN,"INDEFINITE OVERWRITE",DATE)=""
.S DATE=$$FMADD^XLFDT(DT,-14)
.F S DATE=$O(^SC(CLINIEN,"T"_TNODE,DATE)) Q:'DATE D
..I $O(^SC(CLINIEN,"T"_TNODE,DATE))=9999999,$D(^SC(CLINIEN,"OST",DATE)) D
...Q:'$D(^SC(CLINIEN,"OST",DATE,1))
...Q:^SC(CLINIEN,"OST",DATE,1)'["["
...S GHOST(CLINIEN,"INDEFINITE OVERWRITE",DATE)=""
Q
;
ORPHANEDOSTDAYS(GHOST,CLINIEN) ;
N DATE
;
S DATE=$$FMADD^XLFDT(DT,-14)
F S DATE=$O(^SC(CLINIEN,"OST",DATE)) Q:'DATE D
.Q:'$D(^SC(CLINIEN,"OST",DATE,1))
.Q:^SC(CLINIEN,"OST",DATE,1)'["["
.I '$D(^SC(CLINIEN,"T",DATE)) D
..S GHOST(CLINIEN,"ORPHANED OST",DATE)=""
Q
;
TASK3 ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*950 Post-Install to identify potential disappearing grid scenarios prior to remap.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*950 Post Install Routine Task 3"
D NOW^%DTC
S ZTDTH=$P($H,",",1)_","_86399,ZTIO="",ZTRTN="REPORT3^SDES950P",ZTSAVE("*")=""
D ^%ZTLOAD
I $D(ZTSK) D Q
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D Q
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
REPORT3 ;
N CREATEDT,UPDATECNT
K ^XTMP("SDES950P-3")
S ^XTMP("SDES950P-3",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*950"
S UPDATECNT=1
S UPDATECNT=UPDATECNT+1
;ADD LOGIC HERE
D DISPGRIDS
;
D MAIL3
Q
;
MAIL3 ;
N SITENUMBER,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ,PROD
S SITENUMBER=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
S PROD=$$PROD^XUPROD
S MESS1="Station: "_SITENUMBER_" ("_$S(PROD:"PROD",1:"TEST")_") - "
S XMDUZ=DUZ
S XMTEXT="^XTMP(""SDES950P-3"","
S XMSUB=MESS1_"SD*5.3*950 - Potential Disappearing Grid Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("SWESKY.JEFFREY@DOMAIN.EXT")=""
I PROD D
. S XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
. S XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
D ^XMD
Q
;
DISPGRIDS() ;
;
N CLINIEN,CLINICNAME,COUNT,ENDDATE,GRIDDATE,HOLSCHED,PATTERN,STARTDATE,TNODE
;
K ^XTMP("SDES950P-3")
S COUNT=1
S ^XTMP("SDES950P-3",COUNT)="*****************************POTENTIAL DISAPPEARING GRIDS REPORT*****************************"
S COUNT=COUNT+1
S ^XTMP("SDES950P-3",COUNT)="CLINIC IEN^CLINIC NAME^DESCRIPTION OF ISSUE//LIST OF APPTS ON SEPARATE ROWS"
;
S CLINIEN=0
F S CLINIEN=$O(^SC(CLINIEN)) Q:'CLINIEN D
. Q:$$INACTIVE^SDESUTIL(CLINIEN)
. Q:$$GET1^DIQ(44,CLINIEN,2,"I")'="C"
. S CLINICNAME=$$GET1^DIQ(44,CLINIEN,.01)
. S HOLSCHED=$S($$GET1^DIQ(44,CLINIEN,1918.5,"I")="Y":1,1:0)
. F TNODE=0:1:6 I $D(^SC(CLINIEN,"T"_TNODE)) D
. . S STARTDATE=$$FMADD^XLFDT(DT,+1)
. . S STARTDATE=$O(^SC(CLINIEN,"T"_TNODE,STARTDATE),-1)
. . I STARTDATE=0 S STARTDATE=$O(^SC(CLINIEN,"T"_TNODE,STARTDATE))
. . Q:'STARTDATE
. . S ENDDATE=$O(^SC(CLINIEN,"T"_TNODE,STARTDATE))
. . I ENDDATE="" S ENDDATE=STARTDATE
. . S PATTERN=^SC(CLINIEN,"T"_TNODE,ENDDATE,1)
. . I PATTERN="" D CHECKGRID(CLINIEN,STARTDATE,ENDDATE,HOLSCHED,TNODE)
. . F S STARTDATE=$O(^SC(CLINIEN,"T"_TNODE,STARTDATE)) Q:'STARTDATE!(ENDDATE=9999999) D
. . . S ENDDATE=$O(^SC(CLINIEN,"T"_TNODE,STARTDATE))
. . . I ENDDATE="" S ENDDATE=STARTDATE
. . . S PATTERN=^SC(CLINIEN,"T"_TNODE,ENDDATE,1)
. . . I PATTERN="" D CHECKGRID(CLINIEN,STARTDATE,ENDDATE,HOLSCHED,TNODE)
Q
;
CHECKGRID(CLINIEN,GRIDDATE,ENDDATE,HOLSCHED,TNODE) ;
N FOUND
S FOUND=0
I GRIDDATE=9999999 S GRIDDATE=DT
I GRIDDATE<DT S GRIDDATE=DT
S GRIDDATE=GRIDDATE-.0001
F S GRIDDATE=$O(^SC(CLINIEN,"ST",GRIDDATE)) Q:'GRIDDATE!(GRIDDATE>ENDDATE) D
. Q:($$FMTH^XLFDT(GRIDDATE)+4#7)'=TNODE
. Q:($D(^HOLIDAY(GRIDDATE))&('HOLSCHED))
. Q:$G(^SC(CLINIEN,"ST",GRIDDATE,1))'["["
. Q:$G(^SC(CLINIEN,"OST",GRIDDATE,1))["["
. I 'FOUND D
. . S COUNT=COUNT+1,FOUND=1
. . S ^XTMP("SDES950P-3",COUNT)=CLINIEN_U_CLINICNAME_U_"The T"_TNODE_" node pattern from "_$$FMTE^XLFDT(STARTDATE,5)_" to "_$$FMTE^XLFDT(ENDDATE,5)
. . S ^XTMP("SDES950P-3",COUNT)=^XTMP("SDES950P-3",COUNT)_" has been removed, but there is ST node availability starting on "_$$FMTE^XLFDT(GRIDDATE,5)
. N APPTDTTM,APPTIEN,HASAPPTS
. S APPTDTTM=GRIDDATE-.0001,HASAPPTS=0
. F S APPTDTTM=$O(^SC(CLINIEN,"S",APPTDTTM)) Q:HASAPPTS!('APPTDTTM)!($P(APPTDTTM,".")>GRIDDATE) D
. . S APPTIEN=0 F S APPTIEN=$O(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN)) Q:'APPTIEN D
. . . Q:$P($G(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN,0)),"^",9)="C"
. . . Q:'$D(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN,0))
. . . S COUNT=COUNT+1,HASAPPTS=1
. . . S ^XTMP("SDES950P-3",COUNT)=" ... and appointments are scheduled on: "_$$FMTE^XLFDT($P(APPTDTTM,"."),5)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES950P 12720 printed Oct 28, 2026@01:50:36 Page 2
SDES950P ;ALB/LAB,JHC - SD*5.3*950 Post Init Routine ; Jul 08, 2026
+1 ;;5.3;SCHEDULING;**950**;AUG 13, 1993;Build 6
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;;
+4 QUIT
+5 ;
EN ;
+1 DO TASK
DO TASK2
DO TASK3
+2 QUIT
+3 ;
TASK ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*950 Post-Install to identify clinics with slot decrement issues")
+3 DO MES^XPDUTL("")
+4 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE,%,%H,%I
+5 SET ZTDESC="SD*5.3*950 Post Install Routine Task 1"
+6 DO NOW^%DTC
+7 SET ZTDTH=$PIECE($HOROLOG,",",1)_","_86399
SET ZTIO=""
SET ZTRTN="REPORT^SDES950P"
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
+16 ;
REPORT ;
+1 NEW COUNT,STOPCODEIEN,CLINICCOUNT,ISSUECOUNT,STOPCODE,CLINIEN,SLOTCOUNT,SLOTSTART,CURRENTSLOTS,DATE,TIME
+2 NEW DAYOFTHEWEEK,SCHEDULEDATE,SUBIEN,ORIGINALSLOTS,APPTSUBIEN,APPTCOUNT,FOUND,SLOTDATETIME,DFN,DFNLIST,%,%DT,I
+3 KILL ^XTMP("SDES950P")
+4 SET ^XTMP("SDES950P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*950"
+5 SET ^XTMP("SDES950P",1)="**********************************SLOT REPORT**********************************"
+6 SET COUNT=4
+7 SET ^XTMP("SDES950P",COUNT)="Clinic IEN^Clinic Name^Slot Date Time^Appointment Count^Original Count^Current Count^Patient DFN*Appointment IEN (|list)"
+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 SET CLINIEN=0
+13 FOR
SET CLINIEN=$ORDER(^SC("AST",STOPCODEIEN,CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:2
+14 SET CLINICCOUNT=CLINICCOUNT+1
+15 KILL @$NAME(^TMP($JOB,"SLOTSEARCH"))
+16 DO GETSLOTS^SDEC57($NAME(^TMP($JOB,"SLOTSEARCH")),$$GETRES^SDES2UTIL1(CLINIEN),$$FMADD^XLFDT(DT-365),$$FMADD^XLFDT(DT,390))
+17 SET SLOTCOUNT=0
+18 FOR
SET SLOTCOUNT=$ORDER(^TMP($JOB,"SLOTSEARCH",SLOTCOUNT))
if 'SLOTCOUNT
QUIT
Begin DoDot:3
+19 SET SLOTSTART=+$PIECE($GET(^TMP($JOB,"SLOTSEARCH",SLOTCOUNT)),U,2)
+20 SET CURRENTSLOTS=$PIECE($GET(^TMP($JOB,"SLOTSEARCH",SLOTCOUNT)),U,4)
+21 IF CURRENTSLOTS?1A
SET CURRENTSLOTS=$FIND("abcdefghijklmnopqrstuvwxyz",CURRENTSLOTS)-1
+22 SET DATE=$PIECE(SLOTSTART,".")
+23 ;quit if holiday and clinic doesn't meet on holiday
+24 if $DATA(^HOLIDAY(DATE,0))&($$GET1^DIQ(44,CLINIEN,1918.5,"E")'="YES")
QUIT
+25 if $GET(^SC(CLINIEN,"ST",DATE,1))["CANCELLED"
QUIT
+26 ;cancelled time slot
if CURRENTSLOTS="X"
QUIT
+27 SET TIME=$EXTRACT(SLOTSTART,8,$LENGTH(SLOTSTART))
+28 SET DAYOFTHEWEEK=$$DOW^XLFDT(DATE)
+29 SET SCHEDULEDATE=$SELECT('$DATA(^SC(CLINIEN,"T",DATE)):$$GETINDEFSLOTDATE(CLINIEN,$$FMADD^XLFDT(DATE,1),"T"_$$UP^XLFSTR($$DOW^XLFDT(DATE,1))),1:DATE)
+30 if $$INACTIVE^SDES2UTIL(CLINIEN,DATE)
QUIT
+31 if '(SCHEDULEDATE)
QUIT
+32 SET SUBIEN=0
SET SLOTDATETIME=0
SET FOUND=0
+33 FOR
SET SUBIEN=$ORDER(^SC(CLINIEN,"T",SCHEDULEDATE,2,SUBIEN))
if 'SUBIEN!(FOUND=1)
QUIT
Begin DoDot:4
+34 IF SLOTSTART=$$HTFM^XLFDT($$FMTH^XLFDT(DATE_"."_$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINIEN_",",.01,"I")))
Begin DoDot:5
+35 SET ORIGINALSLOTS=$$GET1^DIQ(44.004,SUBIEN_","_SCHEDULEDATE_","_CLINIEN_",",1,"I")
+36 SET APPTSUBIEN=0
SET APPTCOUNT=0
+37 SET DFNLIST=""
+38 FOR
SET APPTSUBIEN=$ORDER(^SC(CLINIEN,"S",SLOTSTART,1,APPTSUBIEN))
if 'APPTSUBIEN
QUIT
Begin DoDot:6
+39 IF $$GET1^DIQ(44.003,APPTSUBIEN_","_SLOTSTART_","_CLINIEN_",",310,"I")'="C"
Begin DoDot:7
+40 SET APPTCOUNT=APPTCOUNT+1
+41 SET DFN=$$GET1^DIQ(44.003,APPTSUBIEN_","_SLOTSTART_","_CLINIEN_",",.01,"I")
+42 SET DFNLIST=DFNLIST_DFN_"*"_$ORDER(^SDEC(409.84,"APTDT",DFN,SLOTSTART,""),-1)_"|"
End DoDot:7
End DoDot:6
+43 IF (APPTCOUNT>0)&((ORIGINALSLOTS-APPTCOUNT)<CURRENTSLOTS)
Begin DoDot:6
+44 SET ISSUECOUNT=ISSUECOUNT+1
+45 SET ^XTMP("SDES950P",COUNT)=CLINIEN_U_$$GET1^DIQ(44,CLINIEN,.01)_U_$$FMTISO^SDAMUTDT(SLOTSTART)
+46 SET ^XTMP("SDES950P",COUNT)=^XTMP("SDES950P",COUNT)_U_APPTCOUNT_U_ORIGINALSLOTS_U_CURRENTSLOTS_U_DFNLIST
+47 SET COUNT=COUNT+1
+48 SET FOUND=1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+49 SET ^XTMP("SDES950P",2)="Total Number of Clinics Searched : "_CLINICCOUNT
+50 SET COUNT=COUNT+1
+51 SET ^XTMP("SDES950P",3)="Total Number of Issues Found : "_ISSUECOUNT
+52 ;
+53 DO MAIL
+54 QUIT
+55 ;
MAIL ;
+1 NEW SITENUMBER,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ,PROD
+2 SET SITENUMBER=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
+3 SET PROD=$$PROD^XUPROD
+4 SET MESS1="Station: "_SITENUMBER_" ("_$SELECT(PROD:"PROD",1:"TEST")_") - "
+5 SET XMDUZ=DUZ
+6 SET XMTEXT="^XTMP(""SDES950P"","
+7 SET XMSUB=MESS1_"SD*5.3*950 - Post Install Data Report"
+8 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+9 IF 'PROD
Begin DoDot:1
+10 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
End DoDot:1
+11 IF PROD
Begin DoDot:1
+12 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+13 SET XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
+14 SET XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
End DoDot:1
+15 DO ^XMD
+16 QUIT
+17 ;
GETINDEFSLOTDATE(CLINIEN,DATE,TNODE) ;
+1 NEW TDATE,INDEFDATE
+2 ;
+3 SET INDEFDATE=0
+4 FOR
SET DATE=$ORDER(^SC(CLINIEN,"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(CLINIEN,"OST",DATE))
QUIT
+7 SET INDEFDATE=DATE
End DoDot:2
End DoDot:1
+8 QUIT INDEFDATE
+9 ;
TASK2 ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*950 Post-Install to create report of instances of ghost availability.")
+3 DO MES^XPDUTL("")
+4 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+5 SET ZTDESC="SD*5.3*950 Post Install Routine Task 2"
+6 DO NOW^%DTC
+7 SET ZTDTH=$PIECE($HOROLOG,",",1)_","_86399
SET ZTIO=""
SET ZTRTN="REPORT2^SDES950P"
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
QUIT
+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
+16 ;
REPORT2 ;
+1 NEW CREATEDT,UPDATECNT
+2 KILL ^XTMP("SDES950P-2")
+3 SET ^XTMP("SDES950P-2",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*950"
+4 SET UPDATECNT=1
+5 SET UPDATECNT=UPDATECNT+1
+6 ;
+7 DO IDENTIFYGHOST
+8 ;
+9 DO MAIL2
+10 QUIT
+11 ;
MAIL2 ;
+1 NEW SITENUMBER,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ,PROD
+2 SET SITENUMBER=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
+3 SET PROD=$$PROD^XUPROD
+4 SET MESS1="Station: "_SITENUMBER_" ("_$SELECT(PROD:"PROD",1:"TEST")_") - "
+5 SET XMDUZ=DUZ
+6 SET XMTEXT="^XTMP(""SDES950P-2"","
+7 SET XMSUB=MESS1_"SD*5.3*950 - Ghost Availability Data Report"
+8 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+9 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+10 SET XMY("BUTLER.BRANDON@DOMAIN.EXT")=""
+11 SET XMY("SWESKY.JEFFREY@DOMAIN.EXT")=""
+12 IF PROD
Begin DoDot:1
+13 SET XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
+14 SET XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
End DoDot:1
+15 DO ^XMD
+16 QUIT
+17 ;
IDENTIFYGHOST() ;
+1 NEW CLINIEN,GHOST,CLINIEN,CLINICNAME,COUNT,NONSTDDATE,INDEFDATE,STARTDATE,ORPHANDATE
+2 ;
+3 SET CLINIEN=0
+4 FOR
SET CLINIEN=$ORDER(^SC(CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:1
+5 IF $$INACTIVE^SDESUTIL(CLINIEN)
QUIT
+6 SET STARTDATE=$$FMADD^XLFDT(DT,-$$GET1^DIQ(44,CLINIEN,2002))
+7 DO INDEFOVERWRITES(.GHOST,CLINIEN,STARTDATE)
+8 DO ORPHANEDOSTDAYS(.GHOST,CLINIEN)
End DoDot:1
+9 ;
+10 KILL ^XTMP("SDES950P-2")
+11 SET COUNT=1
+12 SET ^XTMP("SDES950P-2",COUNT)="**********************************GHOST AVAILABILITY REPORT**********************************"
+13 SET COUNT=COUNT+1
+14 SET ^XTMP("SDES950P-2",COUNT)="CLINIC^ISSUE DESCRIPTION^DATE"
+15 ;
+16 SET CLINIEN=0
+17 FOR
SET CLINIEN=$ORDER(GHOST(CLINIEN))
SET CLINICNAME=$$GET1^DIQ(44,CLINIEN,.01)
if 'CLINIEN
QUIT
Begin DoDot:1
+18 SET INDEFDATE=0
+19 FOR
SET INDEFDATE=$ORDER(GHOST(CLINIEN,"INDEFINITE OVERWRITE",INDEFDATE))
if 'INDEFDATE
QUIT
Begin DoDot:2
+20 SET COUNT=COUNT+1
+21 SET ^XTMP("SDES950P-2",COUNT)=CLINICNAME_U
+22 SET ^XTMP("SDES950P-2",COUNT)=^XTMP("SDES950P-2",COUNT)_"Indefinite Availability is overlaid with Special Availability"_U_$$FMTISO^SDAMUTDT(INDEFDATE)
End DoDot:2
+23 SET ORPHANDATE=0
+24 FOR
SET ORPHANDATE=$ORDER(GHOST(CLINIEN,"ORPHANED OST",ORPHANDATE))
if 'ORPHANDATE
QUIT
Begin DoDot:2
+25 SET COUNT=COUNT+1
+26 SET ^XTMP("SDES950P-2",COUNT)=CLINICNAME_U
+27 SET ^XTMP("SDES950P-2",COUNT)=^XTMP("SDES950P-2",COUNT)_"Unable to define precise time for special availability defined"_U_$$FMTISO^SDAMUTDT(ORPHANDATE)
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT
+30 ;
INDEFOVERWRITES(GHOST,CLINIEN,DATE) ;
+1 NEW TNODE
+2 ;
+3 FOR TNODE=0:1:6
IF $DATA(^SC(CLINIEN,"T"_TNODE))
Begin DoDot:1
+4 IF $ORDER(^SC(CLINIEN,"T"_TNODE,0))=9999999
IF $DATA(^SC(CLINIEN,"OST"))
Begin DoDot:2
+5 SET DATE=$$FMADD^XLFDT(DT,-14)
+6 FOR
SET DATE=$ORDER(^SC(CLINIEN,"OST",DATE))
if 'DATE
QUIT
Begin DoDot:3
+7 if '$DATA(^SC(CLINIEN,"OST",DATE,1))
QUIT
+8 if ^SC(CLINIEN,"OST",DATE,1)'["["
QUIT
+9 IF TNODE=($$FMTH^XLFDT(DATE)+4#7)
Begin DoDot:4
+10 SET GHOST(CLINIEN,"INDEFINITE OVERWRITE",DATE)=""
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+11 SET DATE=$$FMADD^XLFDT(DT,-14)
+12 FOR
SET DATE=$ORDER(^SC(CLINIEN,"T"_TNODE,DATE))
if 'DATE
QUIT
Begin DoDot:2
+13 IF $ORDER(^SC(CLINIEN,"T"_TNODE,DATE))=9999999
IF $DATA(^SC(CLINIEN,"OST",DATE))
Begin DoDot:3
+14 if '$DATA(^SC(CLINIEN,"OST",DATE,1))
QUIT
+15 if ^SC(CLINIEN,"OST",DATE,1)'["["
QUIT
+16 SET GHOST(CLINIEN,"INDEFINITE OVERWRITE",DATE)=""
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
ORPHANEDOSTDAYS(GHOST,CLINIEN) ;
+1 NEW DATE
+2 ;
+3 SET DATE=$$FMADD^XLFDT(DT,-14)
+4 FOR
SET DATE=$ORDER(^SC(CLINIEN,"OST",DATE))
if 'DATE
QUIT
Begin DoDot:1
+5 if '$DATA(^SC(CLINIEN,"OST",DATE,1))
QUIT
+6 if ^SC(CLINIEN,"OST",DATE,1)'["["
QUIT
+7 IF '$DATA(^SC(CLINIEN,"T",DATE))
Begin DoDot:2
+8 SET GHOST(CLINIEN,"ORPHANED OST",DATE)=""
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
TASK3 ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*950 Post-Install to identify potential disappearing grid scenarios prior to remap.")
+3 DO MES^XPDUTL("")
+4 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+5 SET ZTDESC="SD*5.3*950 Post Install Routine Task 3"
+6 DO NOW^%DTC
+7 SET ZTDTH=$PIECE($HOROLOG,",",1)_","_86399
SET ZTIO=""
SET ZTRTN="REPORT3^SDES950P"
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
QUIT
+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
QUIT
+15 QUIT
+16 ;
REPORT3 ;
+1 NEW CREATEDT,UPDATECNT
+2 KILL ^XTMP("SDES950P-3")
+3 SET ^XTMP("SDES950P-3",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*950"
+4 SET UPDATECNT=1
+5 SET UPDATECNT=UPDATECNT+1
+6 ;ADD LOGIC HERE
+7 DO DISPGRIDS
+8 ;
+9 DO MAIL3
+10 QUIT
+11 ;
MAIL3 ;
+1 NEW SITENUMBER,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ,PROD
+2 SET SITENUMBER=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
+3 SET PROD=$$PROD^XUPROD
+4 SET MESS1="Station: "_SITENUMBER_" ("_$SELECT(PROD:"PROD",1:"TEST")_") - "
+5 SET XMDUZ=DUZ
+6 SET XMTEXT="^XTMP(""SDES950P-3"","
+7 SET XMSUB=MESS1_"SD*5.3*950 - Potential Disappearing Grid Report"
+8 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+9 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+10 SET XMY("SWESKY.JEFFREY@DOMAIN.EXT")=""
+11 IF PROD
Begin DoDot:1
+12 SET XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
+13 SET XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
End DoDot:1
+14 DO ^XMD
+15 QUIT
+16 ;
DISPGRIDS() ;
+1 ;
+2 NEW CLINIEN,CLINICNAME,COUNT,ENDDATE,GRIDDATE,HOLSCHED,PATTERN,STARTDATE,TNODE
+3 ;
+4 KILL ^XTMP("SDES950P-3")
+5 SET COUNT=1
+6 SET ^XTMP("SDES950P-3",COUNT)="*****************************POTENTIAL DISAPPEARING GRIDS REPORT*****************************"
+7 SET COUNT=COUNT+1
+8 SET ^XTMP("SDES950P-3",COUNT)="CLINIC IEN^CLINIC NAME^DESCRIPTION OF ISSUE//LIST OF APPTS ON SEPARATE ROWS"
+9 ;
+10 SET CLINIEN=0
+11 FOR
SET CLINIEN=$ORDER(^SC(CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:1
+12 if $$INACTIVE^SDESUTIL(CLINIEN)
QUIT
+13 if $$GET1^DIQ(44,CLINIEN,2,"I")'="C"
QUIT
+14 SET CLINICNAME=$$GET1^DIQ(44,CLINIEN,.01)
+15 SET HOLSCHED=$SELECT($$GET1^DIQ(44,CLINIEN,1918.5,"I")="Y":1,1:0)
+16 FOR TNODE=0:1:6
IF $DATA(^SC(CLINIEN,"T"_TNODE))
Begin DoDot:2
+17 SET STARTDATE=$$FMADD^XLFDT(DT,+1)
+18 SET STARTDATE=$ORDER(^SC(CLINIEN,"T"_TNODE,STARTDATE),-1)
+19 IF STARTDATE=0
SET STARTDATE=$ORDER(^SC(CLINIEN,"T"_TNODE,STARTDATE))
+20 if 'STARTDATE
QUIT
+21 SET ENDDATE=$ORDER(^SC(CLINIEN,"T"_TNODE,STARTDATE))
+22 IF ENDDATE=""
SET ENDDATE=STARTDATE
+23 SET PATTERN=^SC(CLINIEN,"T"_TNODE,ENDDATE,1)
+24 IF PATTERN=""
DO CHECKGRID(CLINIEN,STARTDATE,ENDDATE,HOLSCHED,TNODE)
+25 FOR
SET STARTDATE=$ORDER(^SC(CLINIEN,"T"_TNODE,STARTDATE))
if 'STARTDATE!(ENDDATE=9999999)
QUIT
Begin DoDot:3
+26 SET ENDDATE=$ORDER(^SC(CLINIEN,"T"_TNODE,STARTDATE))
+27 IF ENDDATE=""
SET ENDDATE=STARTDATE
+28 SET PATTERN=^SC(CLINIEN,"T"_TNODE,ENDDATE,1)
+29 IF PATTERN=""
DO CHECKGRID(CLINIEN,STARTDATE,ENDDATE,HOLSCHED,TNODE)
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
CHECKGRID(CLINIEN,GRIDDATE,ENDDATE,HOLSCHED,TNODE) ;
+1 NEW FOUND
+2 SET FOUND=0
+3 IF GRIDDATE=9999999
SET GRIDDATE=DT
+4 IF GRIDDATE<DT
SET GRIDDATE=DT
+5 SET GRIDDATE=GRIDDATE-.0001
+6 FOR
SET GRIDDATE=$ORDER(^SC(CLINIEN,"ST",GRIDDATE))
if 'GRIDDATE!(GRIDDATE>ENDDATE)
QUIT
Begin DoDot:1
+7 if ($$FMTH^XLFDT(GRIDDATE)+4#7)'=TNODE
QUIT
+8 if ($DATA(^HOLIDAY(GRIDDATE))&('HOLSCHED))
QUIT
+9 if $GET(^SC(CLINIEN,"ST",GRIDDATE,1))'["["
QUIT
+10 if $GET(^SC(CLINIEN,"OST",GRIDDATE,1))["["
QUIT
+11 IF 'FOUND
Begin DoDot:2
+12 SET COUNT=COUNT+1
SET FOUND=1
+13 SET ^XTMP("SDES950P-3",COUNT)=CLINIEN_U_CLINICNAME_U_"The T"_TNODE_" node pattern from "_$$FMTE^XLFDT(STARTDATE,5)_" to "_$$FMTE^XLFDT(ENDDATE,5)
+14 SET ^XTMP("SDES950P-3",COUNT)=^XTMP("SDES950P-3",COUNT)_" has been removed, but there is ST node availability starting on "_$$FMTE^XLFDT(GRIDDATE,5)
End DoDot:2
+15 NEW APPTDTTM,APPTIEN,HASAPPTS
+16 SET APPTDTTM=GRIDDATE-.0001
SET HASAPPTS=0
+17 FOR
SET APPTDTTM=$ORDER(^SC(CLINIEN,"S",APPTDTTM))
if HASAPPTS!('APPTDTTM)!($PIECE(APPTDTTM,".")>GRIDDATE)
QUIT
Begin DoDot:2
+18 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:3
+19 if $PIECE($GET(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN,0)),"^",9)="C"
QUIT
+20 if '$DATA(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN,0))
QUIT
+21 SET COUNT=COUNT+1
SET HASAPPTS=1
+22 SET ^XTMP("SDES950P-3",COUNT)=" ... and appointments are scheduled on: "_$$FMTE^XLFDT($PIECE(APPTDTTM,"."),5)
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 QUIT
+25 ;
