SDN0 ;ALB/TMP - NO SHOW AUTO-REBOOK ; 6/21/04 2:09pm
;;5.3;Scheduling;**381,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 11/30/2000 changed $N to $O
; set BSDNO; used to prevent appt letter to be
; asked during event driver
; 12/01/2000 added code for user chosen letter
;
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
I MAX=0 W !,"AUTO-REBOOKING NOT ALLOWED FOR CLINIC ",$P(^SC(SC,0),"^",1) Q
K FSW
S GDATE=CDATE
;IHS/ANMC/LJF 11/30/2000 set of BSDNO
NEW BSDNO S BSDNO=1
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 $G(BSDLET) S SDLET=BSDLET K BSDLET ;IHS/ANMC/LJF 12/01/2000
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
SDN0 ;ALB/TMP - NO SHOW AUTO-REBOOK ; 6/21/04 2:09pm
+1 ;;5.3;Scheduling;**381,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 11/30/2000 changed $N to $O
+3 ; set BSDNO; used to prevent appt letter to be
+4 ; asked during event driver
+5 ; 12/01/2000 added code for user chosen letter
+6 ;
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 IF MAX=0
WRITE !,"AUTO-REBOOKING NOT ALLOWED FOR CLINIC ",$PIECE(^SC(SC,0),"^",1)
QUIT
+3 KILL FSW
+4 SET GDATE=CDATE
+5 ;IHS/ANMC/LJF 11/30/2000 set of BSDNO
+6 NEW BSDNO
SET BSDNO=1
+7 FOR
SET GDATE=$ORDER(^SC(SC,"S",GDATE))
IF GDATE=""!(GDATE>(CDATE+1))
QUIT
Begin DoDot:1
+8 SET L=0
+9 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
+10 IF $GET(ALS)="Y"
WRITE @IOF
+11 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 ;IHS/ANMC/LJF 12/01/2000
IF $GET(BSDLET)
SET SDLET=BSDLET
KILL BSDLET
+3 IF ALS["Y"&(SDLET)
GOTO ^SDN1
+4 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
