close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDUNC.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDUNC.m@ 1780

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
1SDUNC ;MAN/GRR - RESTORE CLINIC AVAILABILITY ; 24 JUL 2003 10:08 am
2 ;;5.3;Scheduling;**79,303,380,452**;Aug 13, 1993
3 D DT^DICRW S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X G:Y<0 SDUNC Q:'$D(^SC(+Y,"SL"))
4 S SC=+Y,SL=^("SL") ;NAKED REFERENCE - ^SC(IFN,"SL")
5 N SDRES S SDRES=$$CLNCK^SDUTL2(SC,1)
6 I 'SDRES W !,?5,"Clinic MUST be corrected before continuing." G SDUNC
7 S %DT="AEXF",%DT("A")="RESTORE '"_$P(Y,U,2)_"' FOR WHAT DATE: " D ^%DT K %DT Q:Y<0
8 S (SD,CDATE)=Y,%=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S(%:%,1:8)
9 K SDIN,SDIN1,SDRE,SDRE1 I $D(^SC(SC,"I")) S SDIN=+^("I"),SDRE=+$P(^("I"),"^",2),Y=SDIN D DTS^SDUTL S SDIN1=Y,Y=SDRE D DTS^SDUTL S SDRE1=Y
10 I $S('$D(SDIN):0,'SDIN:0,SDIN>CDATE:0,SDRE'>CDATE&(SDRE):0,1:1) W !,*7,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),SDIN1,$S(SDRE:" to "_SDRE1,1:"") G SDUNC
11 K SDIN,SDIN1,SDRE,SDRE1 G:'$D(^SC(SC,"ST",SD,1)) NOWAY
12 I $D(^SC(SC,"ST",SD,1)),^(1)'["CANCELLED"&(^(1)'["X") G NOWAY
13 I $D(^SC(SC,"ST",SD,9)) I $D(^SC(SC,"OST",SD,1)) D FIX Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,1)=HOLD K:^(1)'["X" ^SC(SC,"ST",SD,"CAN") W !,"RESTORED!",*7 D CHK Q
14 I $D(^SC(SC,"ST",SD,9)),'$D(^SC(SC,"OST",SD,1)) G ERRM^SDUNC1
15 D B I '$D(DH) G NOPAT
16 Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,0)=SD,^SC(SC,"ST",SD,1)=DH G N
17NOWAY W !,*7,"CLINIC HAS NOT BEEN CANCELLED FOR THAT DATE, SO IT CANNOT BE RESTORED",*7 G SDUNC
18NOPAT W !,*7,"NO UPCOMING OR INDEFINITE APPOINTMENT PATTERN EXISTS FOR DAY OF WEEK,",!,"CREATE 'AVAILABILITY' PATTERN THRU 'CLINIC SETUP', THEN RESTORE AGAIN",*7 G SDUNC
19B S X=SD D DOW^SDM0 S DOW=Y,SS=$O(^SC(SC,"T"_Y,X)) I SS'="",$D(^(SS,1)),^(1)]"" S DH=$P("SU^MO^TU^WE^TH^FR^SA","^",DOW+1)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),DO=X+1,DA(1)=SC,HOLD=DH D FIX2
20 Q
21N I '$F(^SC(SC,"ST",SD,1),"[") K ^SC(SC,"ST",SD) W !,*7,"CLINIC DOES NOT MEET ON THAT DAY" G SDUNC
22 K:^SC(SC,"ST",SD,1)'["X" ^SC(SC,"ST",SD,"CAN") W !,"RESTORED!",*7 D CHK Q
23FIX I ^SC(SC,"ST",SD,1)["X" S SDREST=^SC(SC,"OST",SD,1) D SEL Q
24 S HOLD=^SC(SC,"OST",SD,1)
25 Q
26CHK F N1=SD:0 S N1=$O(^SC(SC,"S",N1)) Q:'N1!(N1\1-SD) I $D(^SC(SC,"S",N1,"MES")) D KMES I $D(SDFR1),'$D(^("MES")) Q
27 Q
28FIX2 Q:^SC(SC,"ST",SD,1)'["X"
29 S SDREST=DH D SEL Q:'$D(SDFR1) S DH=HOLD
30 Q
31SEL K SDFR1 Q:'$D(^SC(SC,"SL")) S SL=^("SL"),%=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S(%:%,1:8)
32 W !,"Clinic has been cancelled for the following periods:",!
33 K SDTEMP,SDZZ S SDZZ=0 F I=SD:0 S I=$O(^SC(SC,"SDCAN",I)) Q:'I!(I\1-SD) S SDZZ=SDZZ+1,X=I D TM S SDFR=X,SDFRX=X1,X="."_$P(^(I,0),"^",2) D TM S SDTO=X,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_SDTO,SDZZ(SDZZ)=SDFRX_"-"_X1
34 F I=SD:0 S I=$O(^SC(SC,"S",I)) Q:'I!(I\1-SD) I $D(^SC(SC,"S",I,"MES")),'$D(^SC(SC,"SDCAN",I)) S X=I D TM S SDFRX=X1,SDFR=X,X="."_$E(^SC(SC,"S",I,"MES"),17,20) D TM S SDZZ=SDZZ+1,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_X,SDZZ(SDZZ)=SDFRX_"-"_X1
35 F I1=0:0 S I1=$O(SDZZ(I1)) Q:'I1 S I=SDTEMP(SDZZ(I1)) W !,?9,"(",$J(I1,2),") ","From: ",$J($P(I,"^",1),8)," To: ",$J($P(I,"^",2),8)
36A K SDFRX,X1,SDFR,SDTO R !!,"RESTORE WHICH PERIOD?: ",X:DTIME Q:"^"[X
37 I X?1"?".E W !,"Enter the # that precedes the time period you want to restore." G A
38 S SDR=X I $D(SDZZ(SDR)),$D(SDTEMP(SDZZ(SDR))) W " ",$P(SDTEMP(SDZZ(SDR)),"^",1)," - ",$P(SDTEMP(SDZZ(SDR)),"^",2) G ROK
39 W !,*7,"INVALID CHOICE, TRY AGAIN" G A
40ROK S X=$P(SDZZ(SDR),"-",1) D TC S FR=X,SDBEG=%+SI+SI,X=$P(SDZZ(SDR),"-",2) D TC S TO=X,SDEND=%+SI+SI
41 S SDFR1=CDATE+(FR/10000) K SDTEMP,SDZZ,SDR
42 S HOLD=^SC(SC,"ST",SD,1),HOLD=$E(HOLD,1,SDBEG-1)_$E(SDREST,SDBEG,SDEND)_$E(HOLD,SDEND+1,80) K ^SC(SC,"SDCAN",SDFR1) I $D(^SC(SC,"SDCAN",0)) S CNT=$P(^(0),U,4),CNT=$S(CNT>0:CNT-1,1:0),^(0)=$P(^(0),U,1,3)_U_CNT K CNT
43 I HOLD'["[" S I5=$F(HOLD,"|"),HOLD=$E(HOLD,1,(I5-2))_"["_$E(HOLD,I5,999) K I5
44 K SDBEG,SDEND,SDANS,SI,STARTDAY,FR,TO Q
45KMES I '$D(SDFR1) K ^("MES") Q ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES")
46 I $D(SDFR1),N1=SDFR1 K ^("MES") Q ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES")
47 Q
48TC S %=$E(X,3,4),%=X\100-STARTDAY*SI+(%*SI\60)*2
49 Q
50TM S X=$E($P(X,".",2)_"0000",1,4),X1=X,%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M" Q
Note: See TracBrowser for help on using the repository browser.