source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCNP1.m@ 1379

Last change on this file since 1379 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.5 KB
Line 
1SDCNP1 ;ALB/LDB - CANCEL APPOINTMENT (cont.) ; 14 MAR 88@13:00
2 ;;5.3;Scheduling;**398,467,478**;Aug 13, 1993
3 ;
4 ;SD/467 - EWL Open Matched Entry with rebook
5NOPE W !,*7,$S(CNT:CNT_" Appointment"_$S(CNT>1:"s",1:"")_" cancelled",1:"NOTHING CANCELLED")
6 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
7 ;no rebooking to take place; open EWL entries only if applicable
8 I $D(DFN)>0 D EWL(DFN) ;SD/467
9 I SDA,SDCNT W !,*7,"NO AUTO-REBOOKING --Patient has died."
10 I 'SDA,SDCNT S A=DFN D LOOP1^SDCNP1A,LET
11END K:'$D(DIROUT) DFN D END^SDCNP Q:$D(DIROUT) G RD^SDCNP
12ASK 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
13 .W !,"OK"
14 W !!,"PLEASE NOTE THAT YOU MUST ENTER A DEVICE TO AUTO-REBOOK",!
15ZIS S %ZIS("A")="DEVICE TO OUTPUT REBOOKED APPT(S). :",%ZIS="QN" D ^%ZIS I POP S X8="^" Q
16 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)
17 D SDLST
18LST 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
19 D WH
20 I B>0 G:SDCTRL&(A8']"") NOPE1 G:SDCTRL DEL
21 Q
22SDLST 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
23 Q
24MORE S SDCTR=SDCTR+2 I AT W ?41,$P(^UTILITY($J,"SDCNP2",B),"^",2) G OVR
25 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
26OVR I SDCTR>20,$O(^UTILITY($J,"SDCNP2",B))>0 S (SDCTRL,SDCTR)=0 W *7 D WH W:'SDCTRL @IOF
27 Q
28WH 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
29 I A8["?" X SDMSG G WH
30DEL S SDERR=0 F J=1:1 S SDDH=$P(A8,",",J) Q:SDDH']"" D MTCH
31 I SDERR G LST
32DEL1 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
33 G:SDERR LST Q:A8["^"!(A8="") S SDERR=0 D ^SDCNP1A Q:X8="^"
34 D:MAX QUE
35 D NOPE1
36 Q
37LET 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)
38 I $$BADADR^DGUTL3(+DFN) D Q ;display, don't print BAI list
39 . W *7,!,"** THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
40 . W !,"WILL BE PRINTED."
41 . S DIR(0)="E" D ^DIR K DIR(0)
42QUE2 ;S DGPGM="SDLET^SDCNP1A",DGVAR="SDCL#^DUZ^DFN^DT^A^SDWH" D ZIS^DGUTQ D:POP CLOSE^DGUTQ Q:POP D SDLET^SDCNP1A Q
43 S %ZIS="MQ" K IO("Q") D ^%ZIS Q:POP ;SD/478
44 I $D(IO("Q")) D D:IO'=IO(0) NOTELTR D ^%ZISC W @IOF Q ;SD/478
45 .S ZTRTN="SDLET^SDCNP1A" F ZTS="SDCL(","DUZ","DFN","DT","A","SDWH","AUTO(" S ZTSAVE(ZTS)="" ;SD/478
46 .K ZTS D ^%ZTLOAD ;SD/478
47 D:IO'=IO(0) NOTELTR D SDLET^SDCNP1A,^%ZISC W @IOF ;SD/478
48 Q ;SD/478
49NOTELTR I ANS["Y",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.
50 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.
51 Q
52QUE I IO'=IO(0) S DGPGM="^SDCNP2",DGVAR="SDCL#^NDATE^A^GDATE^DT^DUZ",IOP=IO,X="NOW" D Q1^DGUTQ Q
53 U IO I IO=IO(0),$E(IOST,1,2)="C-" S SDIO=1 D ^SDCNP2 Q
54NOPE1 W @IOF,!,*7,$S(SDCNT1:SDCNT1_" Appointment"_$S(SDCNT1>1:"s",1:"")_" rebooked",1:"NOTHING REBOOKED") Q
55REBK K ^UTILITY($J,"SDCNP") S ^UTILITY($J,"SDCNP2","REBK",DFN,Z9)=^UTILITY($J,"SDCNP2",DFN,Z9)
56 Q
57 F A9=SDDI,SDDM Q:'SDDM&(SDDI-A9) I '$D(Z1(A9)) S SDERR=1 W !,*7,"There is no appointment number ",A9
58 Q
59REASK W !,"ANSWER (Y)ES OR (N)O" Q
60CLRK S $P(^DPT(DFN,"S",S,0),"^",19)=$P(SDNODE,"^",7),$P(^DPT(DFN,"S",S,0),"^",18)=$P(SDNODE,"^",6) Q
61MTCH Q:SDDH?1N.N!(SDDH?1.N1"-".N) S SDERR=1 X SDMSG
62 Q
63EWL(DFN) ;
64 I '$D(^UTILITY($J,"SDCNP1")) I '$D(^UTILITY($J,"SDCNP")) Q
65 ;call to EWL to open and optionally close EWL entry with rebooked appointment
66 N SDFRB,SDT,SC,SDREB K ^TMP("SDWLREB",$J),^TMP($J,"SDWPL"),^TMP($J,"APPT")
67 I $D(^UTILITY($J,"SDCNP1")) S SDFRB="^UTILITY($J,""SDCNP1"")" D REB I $D(^TMP("SDWLREB",$J)) D MESS^SDWLREB Q
68 E S SDFRB="^UTILITY($J,""SDCNP"")" D CAN I $D(^TMP("SDWLREB",$J)) D MESS^SDWLREB
69 Q
70REB 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
71 .;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
72 .N RBFLG,SDTRB D REBOOK^SDWLREB(DFN,SDT,SC,.RBFLG,.SDTRB)
73 .I $E(RBFLG,1,2)'="CC" Q ;not canceled by clinic
74 .I RBFLG="CCR" S SDREB=1 D DISREB^SDWLREB(DFN,SDTRB,SC)
75 .D OPENEWL^SDWLREB(DFN,SDT,SC,SDREB) K ^TMP($J,"APPT"),^TMP($J,"SDWLPL")
76 Q
77CAN 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
78 .N RBFLG,SDTRB D REBOOK^SDWLREB(DFN,SDT,SC,.RBFLG,.SDTRB)
79 .I $E(RBFLG,1,2)'="CC" Q ;not canceled by clinic
80 .I RBFLG="CCR" S SDREB=1 D DISREB^SDWLREB(DFN,SDTRB,SC)
81 .D OPENEWL^SDWLREB(DFN,SDT,SC,SDREB) K ^TMP($J,"APPT"),^TMP($J,"SDWLPL")
82 Q
Note: See TracBrowser for help on using the repository browser.