- SDCNP1 ;ALB/LDB - CANCEL APPOINTMENT (cont.) ; 5/25/12 11:42am
- ;;5.3;Scheduling;**398,467,478,554,597,682,719**;Aug 13, 1993;Build 3
- ;
- ;SD/467 - EWL Open Matched Entry with rebook
- NOPE W !,*7,$S(CNT:CNT_" Appointment"_$S(CNT>1:"s",1:"")_" cancelled",1:"NOTHING CANCELLED")
- N SDCLNK S SDCLNK=$G(SC) ; Hold value of SC for EWL Notification call
- S SDCNT=CNT,SDA=1,SDCNT1=0 I CNT,$S('$D(^DPT(DFN,.35)):1,'$P(^(.35),U):1,1:0) S (SDA,X8)=0 D ASK G:X8="^" END
- ;no rebooking to take place; open EWL entries only if applicable
- I $D(DFN)>0 D EWL(DFN) ;SD/467
- I SDA,SDCNT W !,*7,"NO AUTO-REBOOKING --Patient has died."
- I 'SDA,SDCNT S A=DFN D LOOP1^SDCNP1A,LET,CANQ^SDAMC(DFN,$G(SDCLNK)) K SDCLNK
- ;Calls subroutine CANQ to display wait list message if applicable. - PATCH SD*5.3*597
- END K:'$D(DIROUT) DFN D END^SDCNP Q:$D(DIROUT) G RD^SDCNP
- ;Remove AUTO-REBOOK quit at ASK line, SD*5.3*682
- ASK Q
- S (SDCTR,SDCTRL)=0,%=2 W !!,"DO YOU WISH TO REBOOK ANY APPOINTMENT(S) THAT YOU HAVE CANCELLED" D YN^DICN S ALS=% D:'% REASK G:'% ASK I %-1 S CNT=0 S:%<0 X8="^" D Q
- .W !,"OK"
- W !!,"PLEASE NOTE THAT YOU MUST ENTER A DEVICE TO AUTO-REBOOK",!
- ZIS S %ZIS("A")="DEVICE TO OUTPUT REBOOKED APPT(S). :",%ZIS="QN" D ^%ZIS I POP S X8="^" Q
- S L=0 F S L=$O(^UTILITY($J,"SDCNP",L)) Q:'L I $P(^(L),U,4)="*** JUST CANCELLED ***" S ^UTILITY($J,"SDCNP1",DFN,$P(^(L),"^",2),$P(^(L),"^"))=^(L)
- D SDLST
- LST S B=0 F S B=$O(^UTILITY($J,"SDCNP2",DFN,B)) Q:'B W !!,$J($S(B\1=B:"("_$J(B,2)_") ",1:""),5) S AT=$S($P(^(B),"^",2)'?.N:1,1:0),Y=$P($P(^(B),"^"),".") D DT^SDM0 S X=$P(^(B),"^") X ^DD("FUNC",2,1) W " ",$J(X,8) S Z1(B)="" D MORE Q:SDCTRL
- D WH
- I B>0 G:SDCTRL&(A8']"") NOPE1 G:SDCTRL DEL
- Q
- SDLST S L1=0 S Z5=0 F S Z5=$O(^UTILITY($J,"SDCNP1",DFN,Z5)) Q:'Z5 F Z6=0:0 S Z7=Z6,Z6=$O(^UTILITY($J,"SDCNP1",DFN,Z5,Z6)) I Z6="" S L1=L1+1,^UTILITY($J,"SDCNP2",DFN,L1)=Z7_"^"_Z5_"^"_$P(^(Z7),"^",3,6) Q
- Q
- MORE S SDCTR=SDCTR+2 I AT W ?41,$P(^UTILITY($J,"SDCNP2",B),"^",2) G OVR
- S S5=^UTILITY($J,"SDCNP2",DFN,B) W " (",$P(S5,"^",6)," MINUTES) ",$S($D(^SC($P(S5,"^",2),0)):$P(^(0),"^",1),1:"DELETED CLINIC"),$P(S5,"^",3) S M1=$P(^SC($P(S5,"^",2),"SDP"),"^",4) W !,?41,"Max days for rebooking= ",M1
- OVR I SDCTR>20,$O(^UTILITY($J,"SDCNP2",B))>0 S (SDCTRL,SDCTR)=0 W *7 D WH W:'SDCTRL @IOF
- Q
- WH W !!,"SELECT APPOINTMENT(S) TO BE REBOOKED" W:B>0 " OR HIT RETURN TO CONTINUE DISPLAY" R ": ",A8:DTIME I '$T!(A8="^") S SDCTRL=1,A8="",X8="^" Q
- I A8["?" X SDMSG G WH
- DEL S SDERR=0 F J=1:1 S SDDH=$P(A8,",",J) Q:SDDH']"" D MTCH
- I SDERR G LST
- DEL1 S SDERR=0 F J=1:1 S SDDH=$P(A8,",",J) Q:SDDH']"" S SDDI=$P(SDDH,"-"),SDDM=$P(SDDH,"-",2) D CKK^SDCNP1A Q:SDERR D CKK2^SDCNP1A Q:SDERR F Z9=SDDI:1:$S(SDDM:SDDM,1:SDDI) D:SDDI REBK I 'SDDI S SDERR=1 Q
- G:SDERR LST Q:A8["^"!(A8="") S SDERR=0 D ^SDCNP1A Q:X8="^"
- D:MAX QUE
- D NOPE1
- Q
- LET ;
- S %=2 W !!,"DO YOU WISH TO PRINT LETTERS FOR THE CANCELLED APPOINTMENT(S)" D YN^DICN S ANS="Y" D:'% REASK G:'% LET Q:(%-1)
- I $$BADADR^DGUTL3(+DFN) D Q ;display, don't print BAI list
- . W *7,!,"** THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
- . W !,"WILL BE PRINTED."
- . S DIR(0)="E" D ^DIR K DIR(0)
- QUE2 ;S DGPGM="SDLET^SDCNP1A",DGVAR="SDCL#^DUZ^DFN^DT^A^SDWH" D ZIS^DGUTQ D:POP CLOSE^DGUTQ Q:POP D SDLET^SDCNP1A Q
- S %ZIS="MQ" K IO("Q") D ^%ZIS Q:POP ;SD/478
- I $D(IO("Q")) D D:IO'=IO(0) NOTELTR D ^%ZISC W @IOF Q ;SD/478
- .S ZTRTN="SDLET^SDCNP1A" F ZTS="SDCL(","DUZ","DFN","DT","A","SDWH","AUTO(" S ZTSAVE(ZTS)="" ;SD/478
- .K ZTS D ^%ZTLOAD ;SD/478
- D:IO'=IO(0) NOTELTR D SDLET^SDCNP1A,^%ZISC W @IOF ;SD/478
- Q ;SD/478
- NOTELTR I ANS["Y",$G(ALS)=1 S:$D(CNDIE) @(CNDIE_CNDA_",1,CNINDX,0)")="CANCEL APPOINTMENT AUTO REBOOK letter printed." K CNDIE,CNDA,CNINDX ;SD/478 CANCEL APPT AUTO REBOOK LETTER PRINTED.
- I ANS["Y" S:$D(CNDIE) @(CNDIE_CNDA_",1,CNINDX,0)")="CANCEL APPOINTMENT letter printed." K CNDIE,CNDA,CNINDX ;SD/478 CANCEL APPT LETTER IS PRINTED.
- Q
- QUE I IO'=IO(0) S DGPGM="^SDCNP2",DGVAR="SDCL#^NDATE^A^GDATE^DT^DUZ",IOP=IO,X="NOW" D Q1^DGUTQ Q
- U IO I IO=IO(0),$E(IOST,1,2)="C-" S SDIO=1 D ^SDCNP2 Q
- NOPE1 W @IOF,!,*7,$S(SDCNT1:SDCNT1_" Appointment"_$S(SDCNT1>1:"s",1:"")_" rebooked",1:"NOTHING REBOOKED") Q
- REBK K ^UTILITY($J,"SDCNP") S ^UTILITY($J,"SDCNP2","REBK",DFN,Z9)=^UTILITY($J,"SDCNP2",DFN,Z9)
- Q
- F A9=SDDI,SDDM Q:'SDDM&(SDDI-A9) I '$D(Z1(A9)) S SDERR=1 W !,*7,"There is no appointment number ",A9
- Q
- REASK W !,"ANSWER (Y)ES OR (N)O" Q
- CLRK S $P(^DPT(DFN,"S",S,0),"^",19)=$P(SDNODE,"^",7),$P(^DPT(DFN,"S",S,0),"^",18)=$P(SDNODE,"^",6) Q
- MTCH Q:SDDH?1N.N!(SDDH?1.N1"-".N) S SDERR=1 X SDMSG
- Q
- EWL(DFN) ;
- I '$D(^UTILITY($J,"SDCNP1")) I '$D(^UTILITY($J,"SDCNP")) Q
- ;call to EWL to open and optionally close EWL entry with rebooked appointment
- N SDFRB,SDT,SC,SDREB K ^TMP("SDWLREB",$J),^TMP($J,"SDWPL"),^TMP($J,"APPT")
- I $D(^UTILITY($J,"SDCNP1")) S SDFRB="^UTILITY($J,""SDCNP1"")" D REB I $D(^TMP("SDWLREB",$J)) D MESS^SDWLREB Q
- E S SDFRB="^UTILITY($J,""SDCNP"")" D CAN I $D(^TMP("SDWLREB",$J)) D MESS^SDWLREB
- Q
- REB I $D(^UTILITY($J,"SDCNP1")) F S SDFRB=$Q(@SDFRB) Q:SDFRB'["SDCNP1" S SDT=$P(@SDFRB,U),SC=$P(@SDFRB,U,2),SDREB=0 D
- .;N NN F NN=1:1 Q:'$D(^UTILITY($J,"SDCNP","REBK",DFN,NN)) I $P($G(^UTILITY($J,"SDCNP2","REBK",DFN,NN)),U)=SDT S SDREB=1 Q
- .N RBFLG,SDTRB D REBOOK^SDWLREB(DFN,SDT,SC,.RBFLG,.SDTRB)
- .I $E(RBFLG,1,2)'="CC" Q ;not canceled by clinic
- .I RBFLG="CCR" S SDREB=1 D DISREB^SDWLREB(DFN,SDTRB,SC)
- .D OPENEWL^SDWLREB(DFN,SDT,SC,SDREB) K ^TMP($J,"APPT"),^TMP($J,"SDWLPL")
- Q
- CAN I $D(^UTILITY($J,"SDCNP")) F S SDFRB=$Q(@SDFRB) Q:SDFRB'["SDCNP" I @SDFRB["CANCELLED" S SDT=$P(@SDFRB,U),SC=$P(@SDFRB,U,2),SDREB=0 D
- .N RBFLG,SDTRB D REBOOK^SDWLREB(DFN,SDT,SC,.RBFLG,.SDTRB)
- .I $E(RBFLG,1,2)'="CC" Q ;not canceled by clinic
- .I RBFLG="CCR" S SDREB=1 D DISREB^SDWLREB(DFN,SDTRB,SC)
- .D OPENEWL^SDWLREB(DFN,SDT,SC,SDREB) K ^TMP($J,"APPT"),^TMP($J,"SDWLPL")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCNP1 5951 printed Feb 19, 2025@00:15:38 Page 2
- SDCNP1 ;ALB/LDB - CANCEL APPOINTMENT (cont.) ; 5/25/12 11:42am
- +1 ;;5.3;Scheduling;**398,467,478,554,597,682,719**;Aug 13, 1993;Build 3
- +2 ;
- +3 ;SD/467 - EWL Open Matched Entry with rebook
- NOPE WRITE !,*7,$SELECT(CNT:CNT_" Appointment"_$SELECT(CNT>1:"s",1:"")_" cancelled",1:"NOTHING CANCELLED")
- +1 ; Hold value of SC for EWL Notification call
- NEW SDCLNK
- SET SDCLNK=$GET(SC)
- +2 SET SDCNT=CNT
- SET SDA=1
- SET SDCNT1=0
- IF CNT
- IF $SELECT('$DATA(^DPT(DFN,.35)):1,'$PIECE(^(.35),U):1,1:0)
- SET (SDA,X8)=0
- DO ASK
- if X8="^"
- GOTO END
- +3 ;no rebooking to take place; open EWL entries only if applicable
- +4 ;SD/467
- IF $DATA(DFN)>0
- DO EWL(DFN)
- +5 IF SDA
- IF SDCNT
- WRITE !,*7,"NO AUTO-REBOOKING --Patient has died."
- +6 IF 'SDA
- IF SDCNT
- SET A=DFN
- DO LOOP1^SDCNP1A
- DO LET
- DO CANQ^SDAMC(DFN,$GET(SDCLNK))
- KILL SDCLNK
- +7 ;Calls subroutine CANQ to display wait list message if applicable. - PATCH SD*5.3*597
- END if '$DATA(DIROUT)
- KILL DFN
- DO END^SDCNP
- if $DATA(DIROUT)
- QUIT
- GOTO RD^SDCNP
- +1 ;Remove AUTO-REBOOK quit at ASK line, SD*5.3*682
- ASK QUIT
- +1 SET (SDCTR,SDCTRL)=0
- SET %=2
- WRITE !!,"DO YOU WISH TO REBOOK ANY APPOINTMENT(S) THAT YOU HAVE CANCELLED"
- DO YN^DICN
- SET ALS=%
- if '%
- DO REASK
- if '%
- GOTO ASK
- IF %-1
- SET CNT=0
- if %<0
- SET X8="^"
- Begin DoDot:1
- +2 WRITE !,"OK"
- End DoDot:1
- QUIT
- +3 WRITE !!,"PLEASE NOTE THAT YOU MUST ENTER A DEVICE TO AUTO-REBOOK",!
- ZIS SET %ZIS("A")="DEVICE TO OUTPUT REBOOKED APPT(S). :"
- SET %ZIS="QN"
- DO ^%ZIS
- IF POP
- SET X8="^"
- QUIT
- +1 SET L=0
- FOR
- SET L=$ORDER(^UTILITY($JOB,"SDCNP",L))
- if 'L
- QUIT
- IF $PIECE(^(L),U,4)="*** JUST CANCELLED ***"
- SET ^UTILITY($JOB,"SDCNP1",DFN,$PIECE(^(L),"^",2),$PIECE(^(L),"^"))=^(L)
- +2 DO SDLST
- LST SET B=0
- FOR
- SET B=$ORDER(^UTILITY($JOB,"SDCNP2",DFN,B))
- if 'B
- QUIT
- WRITE !!,$JUSTIFY($SELECT(B\1=B:"("_$JUSTIFY(B,2)_") ",1:""),5)
- SET AT=$SELECT($PIECE(^(B),"^",2)'?.N:1,1:0)
- SET Y=$PIECE($PIECE(^(B),"^"),".")
- DO DT^SDM0
- SET X=$PIECE(^(B),"^")
- XECUTE ^DD("FUNC",2,1)
- WRITE " ",$JUSTIFY(X,8)
- SET Z1(B)=""
- DO MORE
- if SDCTRL
- QUIT
- +1 DO WH
- +2 IF B>0
- if SDCTRL&(A8']"")
- GOTO NOPE1
- if SDCTRL
- GOTO DEL
- +3 QUIT
- SDLST SET L1=0
- SET Z5=0
- FOR
- SET Z5=$ORDER(^UTILITY($JOB,"SDCNP1",DFN,Z5))
- if 'Z5
- QUIT
- FOR Z6=0:0
- SET Z7=Z6
- SET Z6=$ORDER(^UTILITY($JOB,"SDCNP1",DFN,Z5,Z6))
- IF Z6=""
- SET L1=L1+1
- SET ^UTILITY($JOB,"SDCNP2",DFN,L1)=Z7_"^"_Z5_"^"_$PIECE(^(Z7),"^",3,6)
- QUIT
- +1 QUIT
- MORE SET SDCTR=SDCTR+2
- IF AT
- WRITE ?41,$PIECE(^UTILITY($JOB,"SDCNP2",B),"^",2)
- GOTO OVR
- +1 SET S5=^UTILITY($JOB,"SDCNP2",DFN,B)
- WRITE " (",$PIECE(S5,"^",6)," MINUTES) ",$SELECT($DATA(^SC($PIECE(S5,"^",2),0)):$PIECE(^(0),"^",1),1:"DELETED CLINIC"),$PIECE(S5,"^",3)
- SET M1=$PIECE(^SC($PIECE(S5,"^",2),"SDP"),"^",4)
- WRITE !,?41,"Max days for rebooking= ",M1
- OVR IF SDCTR>20
- IF $ORDER(^UTILITY($JOB,"SDCNP2",B))>0
- SET (SDCTRL,SDCTR)=0
- WRITE *7
- DO WH
- if 'SDCTRL
- WRITE @IOF
- +1 QUIT
- WH WRITE !!,"SELECT APPOINTMENT(S) TO BE REBOOKED"
- if B>0
- WRITE " OR HIT RETURN TO CONTINUE DISPLAY"
- READ ": ",A8:DTIME
- IF '$TEST!(A8="^")
- SET SDCTRL=1
- SET A8=""
- SET X8="^"
- QUIT
- +1 IF A8["?"
- XECUTE SDMSG
- GOTO WH
- DEL SET SDERR=0
- FOR J=1:1
- SET SDDH=$PIECE(A8,",",J)
- if SDDH']""
- QUIT
- DO MTCH
- +1 IF SDERR
- GOTO LST
- DEL1 SET SDERR=0
- FOR J=1:1
- SET SDDH=$PIECE(A8,",",J)
- if SDDH']""
- QUIT
- SET SDDI=$PIECE(SDDH,"-")
- SET SDDM=$PIECE(SDDH,"-",2)
- DO CKK^SDCNP1A
- if SDERR
- QUIT
- DO CKK2^SDCNP1A
- if SDERR
- QUIT
- FOR Z9=SDDI:1:$SELECT(SDDM:SDDM,1:SDDI)
- if SDDI
- DO REBK
- IF 'SDDI
- SET SDERR=1
- QUIT
- +1 if SDERR
- GOTO LST
- if A8["^"!(A8="")
- QUIT
- SET SDERR=0
- DO ^SDCNP1A
- if X8="^"
- QUIT
- +2 if MAX
- DO QUE
- +3 DO NOPE1
- +4 QUIT
- LET ;
- +1 SET %=2
- WRITE !!,"DO YOU WISH TO PRINT LETTERS FOR THE CANCELLED APPOINTMENT(S)"
- DO YN^DICN
- SET ANS="Y"
- if '%
- DO REASK
- if '%
- GOTO LET
- if (%-1)
- QUIT
- +2 ;display, don't print BAI list
- IF $$BADADR^DGUTL3(+DFN)
- Begin DoDot:1
- +3 WRITE *7,!,"** THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
- +4 WRITE !,"WILL BE PRINTED."
- +5 SET DIR(0)="E"
- DO ^DIR
- KILL DIR(0)
- End DoDot:1
- QUIT
- QUE2 ;S DGPGM="SDLET^SDCNP1A",DGVAR="SDCL#^DUZ^DFN^DT^A^SDWH" D ZIS^DGUTQ D:POP CLOSE^DGUTQ Q:POP D SDLET^SDCNP1A Q
- +1 ;SD/478
- SET %ZIS="MQ"
- KILL IO("Q")
- DO ^%ZIS
- if POP
- QUIT
- +2 ;SD/478
- IF $DATA(IO("Q"))
- Begin DoDot:1
- +3 ;SD/478
- SET ZTRTN="SDLET^SDCNP1A"
- FOR ZTS="SDCL(","DUZ","DFN","DT","A","SDWH","AUTO("
- SET ZTSAVE(ZTS)=""
- +4 ;SD/478
- KILL ZTS
- DO ^%ZTLOAD
- End DoDot:1
- if IO'=IO(0)
- DO NOTELTR
- DO ^%ZISC
- WRITE @IOF
- QUIT
- +5 ;SD/478
- if IO'=IO(0)
- DO NOTELTR
- DO SDLET^SDCNP1A
- DO ^%ZISC
- WRITE @IOF
- +6 ;SD/478
- QUIT
- NOTELTR ;SD/478 CANCEL APPT AUTO REBOOK LETTER PRINTED.
- IF ANS["Y"
- IF $GET(ALS)=1
- if $DATA(CNDIE)
- SET @(CNDIE_CNDA_",1,CNINDX,0)")="CANCEL APPOINTMENT AUTO REBOOK letter printed."
- KILL CNDIE,CNDA,CNINDX
- +1 ;SD/478 CANCEL APPT LETTER IS PRINTED.
- IF ANS["Y"
- if $DATA(CNDIE)
- SET @(CNDIE_CNDA_",1,CNINDX,0)")="CANCEL APPOINTMENT letter printed."
- KILL CNDIE,CNDA,CNINDX
- +2 QUIT
- QUE IF IO'=IO(0)
- SET DGPGM="^SDCNP2"
- SET DGVAR="SDCL#^NDATE^A^GDATE^DT^DUZ"
- SET IOP=IO
- SET X="NOW"
- DO Q1^DGUTQ
- QUIT
- +1 USE IO
- IF IO=IO(0)
- IF $EXTRACT(IOST,1,2)="C-"
- SET SDIO=1
- DO ^SDCNP2
- QUIT
- NOPE1 WRITE @IOF,!,*7,$SELECT(SDCNT1:SDCNT1_" Appointment"_$SELECT(SDCNT1>1:"s",1:"")_" rebooked",1:"NOTHING REBOOKED")
- QUIT
- REBK KILL ^UTILITY($JOB,"SDCNP")
- SET ^UTILITY($JOB,"SDCNP2","REBK",DFN,Z9)=^UTILITY($JOB,"SDCNP2",DFN,Z9)
- +1 QUIT
- +2 FOR A9=SDDI,SDDM
- if 'SDDM&(SDDI-A9)
- QUIT
- IF '$DATA(Z1(A9))
- SET SDERR=1
- WRITE !,*7,"There is no appointment number ",A9
- +3 QUIT
- REASK WRITE !,"ANSWER (Y)ES OR (N)O"
- QUIT
- CLRK SET $PIECE(^DPT(DFN,"S",S,0),"^",19)=$PIECE(SDNODE,"^",7)
- SET $PIECE(^DPT(DFN,"S",S,0),"^",18)=$PIECE(SDNODE,"^",6)
- QUIT
- MTCH if SDDH?1N.N!(SDDH?1.N1"-".N)
- QUIT
- SET SDERR=1
- XECUTE SDMSG
- +1 QUIT
- EWL(DFN) ;
- +1 IF '$DATA(^UTILITY($JOB,"SDCNP1"))
- IF '$DATA(^UTILITY($JOB,"SDCNP"))
- QUIT
- +2 ;call to EWL to open and optionally close EWL entry with rebooked appointment
- +3 NEW SDFRB,SDT,SC,SDREB
- KILL ^TMP("SDWLREB",$JOB),^TMP($JOB,"SDWPL"),^TMP($JOB,"APPT")
- +4 IF $DATA(^UTILITY($JOB,"SDCNP1"))
- SET SDFRB="^UTILITY($J,""SDCNP1"")"
- DO REB
- IF $DATA(^TMP("SDWLREB",$JOB))
- DO MESS^SDWLREB
- QUIT
- +5 IF '$TEST
- SET SDFRB="^UTILITY($J,""SDCNP"")"
- DO CAN
- IF $DATA(^TMP("SDWLREB",$JOB))
- DO MESS^SDWLREB
- +6 QUIT
- REB IF $DATA(^UTILITY($JOB,"SDCNP1"))
- FOR
- SET SDFRB=$QUERY(@SDFRB)
- if SDFRB'["SDCNP1"
- QUIT
- SET SDT=$PIECE(@SDFRB,U)
- SET SC=$PIECE(@SDFRB,U,2)
- SET SDREB=0
- Begin DoDot:1
- +1 ;N NN F NN=1:1 Q:'$D(^UTILITY($J,"SDCNP","REBK",DFN,NN)) I $P($G(^UTILITY($J,"SDCNP2","REBK",DFN,NN)),U)=SDT S SDREB=1 Q
- +2 NEW RBFLG,SDTRB
- DO REBOOK^SDWLREB(DFN,SDT,SC,.RBFLG,.SDTRB)
- +3 ;not canceled by clinic
- IF $EXTRACT(RBFLG,1,2)'="CC"
- QUIT
- +4 IF RBFLG="CCR"
- SET SDREB=1
- DO DISREB^SDWLREB(DFN,SDTRB,SC)
- +5 DO OPENEWL^SDWLREB(DFN,SDT,SC,SDREB)
- KILL ^TMP($JOB,"APPT"),^TMP($JOB,"SDWLPL")
- End DoDot:1
- +6 QUIT
- CAN IF $DATA(^UTILITY($JOB,"SDCNP"))
- FOR
- SET SDFRB=$QUERY(@SDFRB)
- if SDFRB'["SDCNP"
- QUIT
- IF @SDFRB["CANCELLED"
- SET SDT=$PIECE(@SDFRB,U)
- SET SC=$PIECE(@SDFRB,U,2)
- SET SDREB=0
- Begin DoDot:1
- +1 NEW RBFLG,SDTRB
- DO REBOOK^SDWLREB(DFN,SDT,SC,.RBFLG,.SDTRB)
- +2 ;not canceled by clinic
- IF $EXTRACT(RBFLG,1,2)'="CC"
- QUIT
- +3 IF RBFLG="CCR"
- SET SDREB=1
- DO DISREB^SDWLREB(DFN,SDTRB,SC)
- +4 DO OPENEWL^SDWLREB(DFN,SDT,SC,SDREB)
- KILL ^TMP($JOB,"APPT"),^TMP($JOB,"SDWLPL")
- End DoDot:1
- +5 QUIT
