- SDN0 ;ALB/TMP - NO SHOW AUTO-REBOOK ; 6/21/04 2:09pm
- ;;5.3;Scheduling;**381,682**;Aug 13, 1993;Build 10
- START U IO K ^UTILITY($J) I C="ALL" K C
- ;G:ANS'["Y" PLET
- I ANS'["Y" G PLET:$D(C),^SDN1
- I $D(C),$P(^SC(C,0),"^",3)="C",$S($P(^(0),"^",15)="":1,$P(^(0),"^",15)=SDV1:1,1:0) S SC=C D OVR G PLET
- G:$D(C) END
- S SDQ=0
- F S SDQ=$O(^SC(SDQ)) Q:+SDQ=0 D
- .I $P(^SC(SDQ,0),"^",3)="C",$S($P(^(0),"^",15)="":1,$P(^(0),"^",15)=SDV1:1,1:0),($O(^SC(SDQ,"S",SDT))\1)=SDT S SC=SDQ D OVR
- ;G PLET
- G END:ALS="N",^SDN1
- OVR S SL=$S($D(^SC(SC,"SL")):^("SL"),1:"") Q:'SL S %=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S(%:%,1:8),SDSTRTDT=$S(DT>SDT:DT,1:SDT),STIME=$S($D(^SC(SC,"SDP")):$P(^("SDP"),U,3),1:"0800")
- S CDATE=SDT,SDNOSH="" D ^SDAUT1
- ;AUTO-REBOOK NOT ALLOWED SD*5.3*682
- S MAX=0 W !,"AUTO-REBOOKING NOT ALLOWED FOR CLINIC ",$P(^SC(SC,0),"^",1) Q
- K FSW
- S GDATE=CDATE
- F S GDATE=$O(^SC(SC,"S",GDATE)) Q:GDATE=""!(GDATE>(CDATE+1)) D
- .S L=0
- .F S L=$O(^SC(SC,"S",GDATE,1,L)) Q:L="" S A=^(L,0) I $D(^DPT(+A,"S",GDATE,0)),$P(^(0),"^",2)="N",$P(^(0),"^",14)=SDTIME D MAXCK D:'POP EN1^SDAUT2 D ^SDNP
- W:$G(ALS)="Y" @IOF
- Q
- PLET S SDC=SC,SDFORM="" I $D(^DG(40.8,SDV1,"LTR")),^("LTR") S SDFORM=^("LTR")
- S SDLET="" I $D(^SC(SC,"LTR")),^("LTR") S SDLET=+^("LTR")
- I ALS["Y"&(SDLET) G ^SDN1
- W:ALS="Y"&('SDLET) !,$P(^SC(SC,0),"^")," DOES NOT HAVE A NO-SHOW LETTER ASSIGNED TO IT" G END
- MAXCK S POP=0,SDC=SC,SDC=$S('$D(^SC(SC,"SL")):SC,$P(^("SL"),"^",5)']"":SC,1:$P(^("SL"),"^",5))
- K SDIS
- S I=0
- F S I=$O(^DPT(+A,"DE","B",SDC,I)) Q:I=""!($D(SDIS)) D
- .I $D(^DPT(+A,"DE",I)) D
- ..S I1=0
- ..F S I1=$O(^DPT(+A,"DE",I,1,I1)) Q:I1="" S SDD=$P(^(I1,0),"^",3)\1 I '(SDD-SDDT),$P(^(0),"^",4)["Exceeded" D SETM Q
- Q
- SETM S POP=1,(SDIS,NDATE,DUPE)="",MESS="No rebook - Max. # of consecutive no-shows ("_$S($D(^SC(SC,"SDP")):+^("SDP"),1:"")_") has been exceeded"
- Q
- END K %,%DT,%I,%IS,A,A0,A1,A2,ALL,ALS,ANS,BY,CDATE,DA,DATEND,DFN,DH,DHD,DIC,DIS,DIV,DO,DOW,DUPE,F,F1,FLDS,FR,GDATE,I,I1,J,L,K,LET,MAX,MESS,NOAP,P,POP,S1,SC,SD,SD1,SD2,SDD,SDDT,SDMSG,SI,SL,SS,ST,SDSTRTDT,STARTDAY,TO,X,Y,ADDR,B,CLIN,HX,LL
- K DGPGM,DGVAR,Z,D,ENDATE,NDATE,J,SM,SM1,SDTIME,STIME,X1,X2,SDC,SDCT,SDIS,SDRE,SDRE1,SDIN,SDYES,SDT,SDTADE,SDTADB,SDPRT,SDMDT,SDCTR,SDCMAX,SDCONS,SDDIF,SDED,SDFORM,SDLET,SDLT1,SDNOSH,SDQ,SDSOH,SDSTAT,SDZSC,VAUTC,SDV1
- K %ZIS,PDAT,S,TIME,TST,Y1 D CLOSE^DGUTQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDN0 2412 printed Feb 19, 2025@00:25:19 Page 2
- SDN0 ;ALB/TMP - NO SHOW AUTO-REBOOK ; 6/21/04 2:09pm
- +1 ;;5.3;Scheduling;**381,682**;Aug 13, 1993;Build 10
- START USE IO
- KILL ^UTILITY($JOB)
- IF C="ALL"
- KILL C
- +1 ;G:ANS'["Y" PLET
- +2 IF ANS'["Y"
- if $DATA(C)
- GOTO PLET
- GOTO ^SDN1
- +3 IF $DATA(C)
- IF $PIECE(^SC(C,0),"^",3)="C"
- IF $SELECT($PIECE(^(0),"^",15)="":1,$PIECE(^(0),"^",15)=SDV1:1,1:0)
- SET SC=C
- DO OVR
- GOTO PLET
- +4 if $DATA(C)
- GOTO END
- +5 SET SDQ=0
- +6 FOR
- SET SDQ=$ORDER(^SC(SDQ))
- if +SDQ=0
- QUIT
- Begin DoDot:1
- +7 IF $PIECE(^SC(SDQ,0),"^",3)="C"
- IF $SELECT($PIECE(^(0),"^",15)="":1,$PIECE(^(0),"^",15)=SDV1:1,1:0)
- IF ($ORDER(^SC(SDQ,"S",SDT))\1)=SDT
- SET SC=SDQ
- DO OVR
- End DoDot:1
- +8 ;G PLET
- +9 if ALS="N"
- GOTO END
- GOTO ^SDN1
- OVR SET SL=$SELECT($DATA(^SC(SC,"SL")):^("SL"),1:"")
- if 'SL
- QUIT
- SET %=$PIECE(SL,U,6)
- SET SI=$SELECT(%="":4,%<3:4,%:%,1:4)
- SET %=$PIECE(SL,U,3)
- SET STARTDAY=$SELECT(%:%,1:8)
- SET SDSTRTDT=$SELECT(DT>SDT:DT,1:SDT)
- SET STIME=$SELECT($DATA(^SC(SC,"SDP")):$PIECE(^("SDP"),U,3),1:"0800")
- +1 SET CDATE=SDT
- SET SDNOSH=""
- DO ^SDAUT1
- +2 ;AUTO-REBOOK NOT ALLOWED SD*5.3*682
- +3 SET MAX=0
- WRITE !,"AUTO-REBOOKING NOT ALLOWED FOR CLINIC ",$PIECE(^SC(SC,0),"^",1)
- QUIT
- +4 KILL FSW
- +5 SET GDATE=CDATE
- +6 FOR
- SET GDATE=$ORDER(^SC(SC,"S",GDATE))
- if GDATE=""!(GDATE>(CDATE+1))
- QUIT
- Begin DoDot:1
- +7 SET L=0
- +8 FOR
- SET L=$ORDER(^SC(SC,"S",GDATE,1,L))
- if L=""
- QUIT
- SET A=^(L,0)
- IF $DATA(^DPT(+A,"S",GDATE,0))
- IF $PIECE(^(0),"^",2)="N"
- IF $PIECE(^(0),"^",14)=SDTIME
- DO MAXCK
- if 'POP
- DO EN1^SDAUT2
- DO ^SDNP
- End DoDot:1
- +9 if $GET(ALS)="Y"
- WRITE @IOF
- +10 QUIT
- PLET SET SDC=SC
- SET SDFORM=""
- IF $DATA(^DG(40.8,SDV1,"LTR"))
- IF ^("LTR")
- SET SDFORM=^("LTR")
- +1 SET SDLET=""
- IF $DATA(^SC(SC,"LTR"))
- IF ^("LTR")
- SET SDLET=+^("LTR")
- +2 IF ALS["Y"&(SDLET)
- GOTO ^SDN1
- +3 if ALS="Y"&('SDLET)
- WRITE !,$PIECE(^SC(SC,0),"^")," DOES NOT HAVE A NO-SHOW LETTER ASSIGNED TO IT"
- GOTO END
- MAXCK SET POP=0
- SET SDC=SC
- SET SDC=$SELECT('$DATA(^SC(SC,"SL")):SC,$PIECE(^("SL"),"^",5)']"":SC,1:$PIECE(^("SL"),"^",5))
- +1 KILL SDIS
- +2 SET I=0
- +3 FOR
- SET I=$ORDER(^DPT(+A,"DE","B",SDC,I))
- if I=""!($DATA(SDIS))
- QUIT
- Begin DoDot:1
- +4 IF $DATA(^DPT(+A,"DE",I))
- Begin DoDot:2
- +5 SET I1=0
- +6 FOR
- SET I1=$ORDER(^DPT(+A,"DE",I,1,I1))
- if I1=""
- QUIT
- SET SDD=$PIECE(^(I1,0),"^",3)\1
- IF '(SDD-SDDT)
- IF $PIECE(^(0),"^",4)["Exceeded"
- DO SETM
- QUIT
- End DoDot:2
- End DoDot:1
- +7 QUIT
- SETM SET POP=1
- SET (SDIS,NDATE,DUPE)=""
- SET MESS="No rebook - Max. # of consecutive no-shows ("_$SELECT($DATA(^SC(SC,"SDP")):+^("SDP"),1:"")_") has been exceeded"
- +1 QUIT
- END KILL %,%DT,%I,%IS,A,A0,A1,A2,ALL,ALS,ANS,BY,CDATE,DA,DATEND,DFN,DH,DHD,DIC,DIS,DIV,DO,DOW,DUPE,F,F1,FLDS,FR,GDATE,I,I1,J,L,K,LET,MAX,MESS,NOAP,P,POP,S1,SC,SD,SD1,SD2,SDD,SDDT,SDMSG,SI,SL,SS,ST,SDSTRTDT,STARTDAY,TO,X,Y,ADDR,B,CLIN,HX,LL
- +1 KILL DGPGM,DGVAR,Z,D,ENDATE,NDATE,J,SM,SM1,SDTIME,STIME,X1,X2,SDC,SDCT,SDIS,SDRE,SDRE1,SDIN,SDYES,SDT,SDTADE,SDTADB,SDPRT,SDMDT,SDCTR,SDCMAX,SDCONS,SDDIF,SDED,SDFORM,SDLET,SDLT1,SDNOSH,SDQ,SDSOH,SDSTAT,SDZSC,VAUTC,SDV1
- +2 KILL %ZIS,PDAT,S,TIME,TST,Y1
- DO CLOSE^DGUTQ
- QUIT