| 1 | SDB ;FLA/RF,BSN/GRR - SET UP A CLINIC ; 19 SEP 84 11:51 am
|
|---|
| 2 | ;;5.3;Scheduling;**20,63,167,455**;Aug 13, 1993
|
|---|
| 3 | S SDTOP=1,SDZQ=1 K SDREACT
|
|---|
| 4 | C Q:$D(SDREACT)!('$D(SDTOP)) W !! D DT^DICRW S (DLAYGO,DIC)=44,DIC(0)="MAQEZL",DIC("A")="Select CLINIC NAME: ",DIC("DR")="2////C",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))" K SDREACT
|
|---|
| 5 | D ^DIC K DIC("A"),DIC("S") G:Y<0 END S DIE=44,DA=+Y S:$P(Y,U,3)=1 DIE("NO^")=""
|
|---|
| 6 | K SDIN,SDINH,SDRE,SDRE1 I $D(^SC(DA,"I")),+^("I")>0 S SDIN=+^("I"),SDINH=SDIN,SDRE=+$P(^("I"),"^",2)
|
|---|
| 7 | S DR="[SDB]" S:'$D(^SC(DA,"ST",0)) ^SC(DA,"ST",0)="^44.005" D ^DIE K DIE("NO^")
|
|---|
| 8 | EN ;Q:$D(SDONE)&('$D(SDTOP)) SD*5.3*455 added 2nd Go on next line
|
|---|
| 9 | G C:'$D(^SC(DA,"SL")) G C:'+$G(^SC(DA,"SL")) S SL=^("SL"),STARTDAY=8,X=$P(SL,U,3),D=$P(SL,U,6),SI=$S(D:D,1:4),DIC(0)="MAQEZL",(DIC,DIE)="^SC("_DA_",""T"",",DIC("W")=$P($T(DOW),";",3) S:'$D(^("T",0)) ^(0)="^44.002D" S:$L(X) STARTDAY=X
|
|---|
| 10 | ;K SDREACT
|
|---|
| 11 | G1 D:$D(SDREACT)&('$D(SDTOP)) E1 S SI=$P(SL,"^",6) K Y,HY S SDFSW="" S:$D(SDINH) SDIN=SDINH D PRINT
|
|---|
| 12 | S (SDREB,SDEL)=0,(SDSAV,SDPAT)="" R !!,"AVAILABILITY DATE: ",X:DTIME Q:U[X&$D(SDREACT) G C:U[X S %DT="EFX" K Y D ^%DT G HLPD^SDB1:X["?" S POP=0 I $D(SDIN),$S(SDIN>Y!(SDIN=0):0,(SDRE'>Y&(SDRE'=0))!(SDRE=0&(SDIN=0)):0,1:1) D INACT G:POP G1
|
|---|
| 13 | G EN:$D(SDONE)&(Y<0)&('$D(SDTOP)),EN:$D(SDREACT)&(Y<0),C:Y<0&('$D(SDREACT)) S SD=Y,X=Y D DOW^SDM0 S DOW=Y
|
|---|
| 14 | D EN1^SDB0 Q:$D(SDREACT)
|
|---|
| 15 | END K %,%DT,%H,C,CCXN,CNT,COLLAT,CTR,D0,DA,DFN,DG,DGO,DH,DI,DIC,DIE,DIFLD,DIK,DK,DL,DLAYGO,DM,DOW,DR,ENDATE,H1,H2,HSI,I,J,LT,M1,M2,MAX,NSL,POP,S,SB,SC,SD,SDAV,SDCL,SDDIF,SDEL,SDFSW,SDHX,SDIN,SDINA,SDINH,SDREACT,SDSDL,SDL,SDLA,SDMAX,SDMM,SDPAT
|
|---|
| 16 | K SDRE,SDREB,SDRVE,SDSAV,SDSOH,SDT,SDTOP,SDW,SDZQ,SDA1,SI,SL,SLT,SM,SS,SDSTRTDT,STARTDAY,STIME,STR,T1,T2,WY,X,Y,Y1,ZDX
|
|---|
| 17 | Q
|
|---|
| 18 | INACT Q:Y<0 S POP=1,Y=SDIN D DTS^SDUTL S Y1=Y,Y=SDRE D:Y DTS^SDUTL W !,*7,"Clinic is inactive",$S('SDRE:" as of ",1:" from "),Y1,$S('SDRE:"",1:" to "_Y) Q
|
|---|
| 19 | ;
|
|---|
| 20 | E1 S:'$D(^SC(DA,"T"_DOW,9999999,1))&($O(^SC(DA,"T"_DOW,0))>0) ^SC(DA,"T"_DOW,9999999,1)="",^(0)=9999999 D TX^SDB1 S:'$D(SDRE) SDRE=D0 Q
|
|---|
| 21 | DOW ;;S %=$E(^(0),1,3),I=$E(^(0),4,5),I=I>2&'(%#4)+$E("144025036146",I) X "F %=%:-1:281 S I=%#4=1+1+I" W " ",$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,$E(^(0),6,7)+I#7+1),"DAY"
|
|---|
| 22 | Q
|
|---|
| 23 | PRINT ;Print cancelled days
|
|---|
| 24 | N Y I '$D(^TMP("SDAVAIL",$J)) G PRINTQ
|
|---|
| 25 | W !,"Availability has been cancelled previously. The day(s) has been overwritten",!,"with the new availability. Would you like to see the day(s) that has been affected"
|
|---|
| 26 | S %=1 D YN^DICN G:%=-1!(%=2) PRINTQ I %=0 D HELP G PRINT
|
|---|
| 27 | S %ZIS="PMQ" D ^%ZIS I POP G PRINTQ
|
|---|
| 28 | I '$D(IO("Q")) G PRINT1
|
|---|
| 29 | S Y=$$QUE(0) G PRINTQ
|
|---|
| 30 | ;
|
|---|
| 31 | PRINT1 N SDAVAIL,SDLINE S SDAVAIL=0,$P(SDLINE,"=",80)=""
|
|---|
| 32 | U IO W !,"Dates of Availability Previously Cancelled for "_$E($P($G(^SC(DA,0)),U),1,25),?70,$$FDATE^VALM1(DT),!,SDLINE
|
|---|
| 33 | F S SDAVAIL=$O(^TMP("SDAVAIL",$J,SDAVAIL)) Q:'SDAVAIL D
|
|---|
| 34 | .W !,$$FDATE^VALM1(SDAVAIL)_" "_$G(^TMP("SDAVAIL",$J,SDAVAIL))
|
|---|
| 35 | ;
|
|---|
| 36 | PRINTQ K ^TMP("SDAVAIL",$J)
|
|---|
| 37 | D:'$D(ZTQUEUED) ^%ZISC
|
|---|
| 38 | Q
|
|---|
| 39 | HELP ;
|
|---|
| 40 | W !,"Answer 'Y'es or 'N'o."
|
|---|
| 41 | Q
|
|---|
| 42 | QUE(X) ; -- que job
|
|---|
| 43 | ; return: did job que [ 1|yes 0|no ]
|
|---|
| 44 | ;
|
|---|
| 45 | K ZTSK,IO("Q")
|
|---|
| 46 | S ZTDESC="Previously Cancelled Availability Dates",ZTRTN="PRINT1^SDB"
|
|---|
| 47 | F S X=$O(^TMP("SDAVAIL",$J,X)) Q:'X D
|
|---|
| 48 | .S ZTSAVE("^TMP(""SDAVAIL"",$J,")=^TMP("SDAVAIL",$J,X)
|
|---|
| 49 | S ZTSAVE("DA")=DA
|
|---|
| 50 | D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
|
|---|
| 51 | Q $D(ZTSK)
|
|---|
