SDB ;FLA/RF,BSN/GRR - SET UP A CLINIC ;JAN 15, 2016
;;5.3;Scheduling;**20,63,167,455,568,586,627,821**;Aug 13, 1993;Build 9
;
; ICDFMT Added for Patch SD*5.3*586 - ICD10 remediation
N ICDFMT
S SDTOP=1,SDZQ=1 K SDREACT
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
D TURNON^DIAUTL(44,".01;8;2502;2503;2505;2506")
S ZTIO="NULL",ZTDESC="CLINIC SCHEDULE EDIT QUEUE",ZTRTN="PROCESS^SDTMPPRC("_$J_")",ZTDTH=$H D ^%ZTLOAD K ZTIO,ZTDESC,ZTRTN,ZTDTH
D ^DIC K DIC("A"),DIC("S") G:Y<0 END S DIE=44,DA=+Y S:$P(Y,U,3)=1 DIE("NO^")=""
K SDIN,SDINH,SDRE,SDRE1 I $D(^SC(DA,"I")),+^("I")>0 S SDIN=+^("I"),SDINH=SDIN,SDRE=+$P(^("I"),"^",2)
S DR="[SDB]",ICDFMT=4 S:'$D(^SC(DA,"ST",0)) ^SC(DA,"ST",0)="^44.005" D ^DIE K DIE("NO^")
EN ;Q:$D(SDONE)&('$D(SDTOP)) SD*5.3*455 added 2nd Go on next line
D:$P(^SC(DA,0),U,3)="C" SDRES^SDECUTL2(DA) ;alb/sat 627
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
;K SDREACT
G1 D:$D(SDREACT)&('$D(SDTOP)) E1 S SI=$P(SL,"^",6) K Y,HY S SDFSW="" S:$D(SDINH) SDIN=SDINH D PRINT
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
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
D EN1^SDB0 Q:$D(SDREACT)
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
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,DIRUT
Q
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
;
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
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"
Q
PRINT ;Print cancelled days
N Y I '$D(^TMP("SDAVAIL",$J)) G PRINTQ
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"
S %=1 D YN^DICN G:%=-1!(%=2) PRINTQ I %=0 D HELP G PRINT
S %ZIS="PMQ" D ^%ZIS I POP G PRINTQ
I '$D(IO("Q")) G PRINT1
S Y=$$QUE(0) G PRINTQ
;
PRINT1 N SDAVAIL,SDLINE S SDAVAIL=0,$P(SDLINE,"=",80)=""
U IO W !,"Dates of Availability Previously Cancelled for "_$E($P($G(^SC(DA,0)),U),1,25),?70,$$FDATE^VALM1(DT),!,SDLINE
F S SDAVAIL=$O(^TMP("SDAVAIL",$J,SDAVAIL)) Q:'SDAVAIL D
.W !,$$FDATE^VALM1(SDAVAIL)_" "_$G(^TMP("SDAVAIL",$J,SDAVAIL))
;
PRINTQ K ^TMP("SDAVAIL",$J)
D:'$D(ZTQUEUED) ^%ZISC
Q
HELP ;
W !,"Answer 'Y'es or 'N'o."
Q
QUE(X) ; -- que job
; return: did job que [ 1|yes 0|no ]
;
K ZTSK,IO("Q")
S ZTDESC="Previously Cancelled Availability Dates",ZTRTN="PRINT1^SDB"
F S X=$O(^TMP("SDAVAIL",$J,X)) Q:'X D
.S ZTSAVE("^TMP(""SDAVAIL"",$J,")=^TMP("SDAVAIL",$J,X)
S ZTSAVE("DA")=DA
D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
Q $D(ZTSK)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDB 3726 printed Dec 13, 2024@02:48:34 Page 2
SDB ;FLA/RF,BSN/GRR - SET UP A CLINIC ;JAN 15, 2016
+1 ;;5.3;Scheduling;**20,63,167,455,568,586,627,821**;Aug 13, 1993;Build 9
+2 ;
+3 ; ICDFMT Added for Patch SD*5.3*586 - ICD10 remediation
+4 NEW ICDFMT
+5 SET SDTOP=1
SET SDZQ=1
KILL SDREACT
C if $DATA(SDREACT)!('$DATA(SDTOP))
QUIT
WRITE !!
DO DT^DICRW
SET (DLAYGO,DIC)=44
SET DIC(0)="MAQEZL"
SET DIC("A")="Select CLINIC NAME: "
SET DIC("DR")="2////C"
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
KILL SDREACT
+1 DO TURNON^DIAUTL(44,".01;8;2502;2503;2505;2506")
+2 SET ZTIO="NULL"
SET ZTDESC="CLINIC SCHEDULE EDIT QUEUE"
SET ZTRTN="PROCESS^SDTMPPRC("_$JOB_")"
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
KILL ZTIO,ZTDESC,ZTRTN,ZTDTH
+3 DO ^DIC
KILL DIC("A"),DIC("S")
if Y<0
GOTO END
SET DIE=44
SET DA=+Y
if $PIECE(Y,U,3)=1
SET DIE("NO^")=""
+4 KILL SDIN,SDINH,SDRE,SDRE1
IF $DATA(^SC(DA,"I"))
IF +^("I")>0
SET SDIN=+^("I")
SET SDINH=SDIN
SET SDRE=+$PIECE(^("I"),"^",2)
+5 SET DR="[SDB]"
SET ICDFMT=4
if '$DATA(^SC(DA,"ST",0))
SET ^SC(DA,"ST",0)="^44.005"
DO ^DIE
KILL DIE("NO^")
EN ;Q:$D(SDONE)&('$D(SDTOP)) SD*5.3*455 added 2nd Go on next line
+1 ;alb/sat 627
if $PIECE(^SC(DA,0),U,3)="C"
DO SDRES^SDECUTL2(DA)
+2 if '$DATA(^SC(DA,"SL"))
GOTO C
if '+$GET(^SC(DA,"SL"))
GOTO C
SET SL=^("SL")
SET STARTDAY=8
SET X=$PIECE(SL,U,3)
SET D=$PIECE(SL,U,6)
SET SI=$SELECT(D:D,1:4)
SET DIC(0)="MAQEZL"
SET (DIC,DIE)="^SC("_DA_",""T"","
SET DIC("W")=$PIECE($TEXT(DOW),";",3)
if '$DATA(^("T",0))
SET ^(0)="^44.002D"
if $LENGTH(X)
SET STARTDAY=X
+3 ;K SDREACT
G1 if $DATA(SDREACT)&('$DATA(SDTOP))
DO E1
SET SI=$PIECE(SL,"^",6)
KILL Y,HY
SET SDFSW=""
if $DATA(SDINH)
SET SDIN=SDINH
DO PRINT
+1 SET (SDREB,SDEL)=0
SET (SDSAV,SDPAT)=""
READ !!,"AVAILABILITY DATE: ",X:DTIME
if U[X&$DATA(SDREACT)
QUIT
if U[X
GOTO C
SET %DT="EFX"
KILL Y
DO ^%DT
if X["?"
GOTO HLPD^SDB1
SET POP=0
IF $DATA(SDIN)
IF $SELECT(SDIN>Y!(SDIN=0):0,(SDRE'>Y&(SDRE'=0))!(SDRE=0&(SDIN=0)):0,1:1)
DO INACT
if POP
GOTO G1
+2 if $DATA(SDONE)&(Y<0)&('$DATA(SDTOP))
GOTO EN
if $DATA(SDREACT)&(Y<0)
GOTO EN
if Y<0&('$DATA(SDREACT))
GOTO C
SET SD=Y
SET X=Y
DO DOW^SDM0
SET DOW=Y
+3 DO EN1^SDB0
if $DATA(SDREACT)
QUIT
END KILL %,%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
+1 KILL 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,DIRUT
+2 QUIT
INACT if Y<0
QUIT
SET POP=1
SET Y=SDIN
DO DTS^SDUTL
SET Y1=Y
SET Y=SDRE
if Y
DO DTS^SDUTL
WRITE !,*7,"Clinic is inactive",$SELECT('SDRE:" as of ",1:" from "),Y1,$SELECT('SDRE:"",1:" to "_Y)
QUIT
+1 ;
E1 if '$DATA(^SC(DA,"T"_DOW,9999999,1))&($ORDER(^SC(DA,"T"_DOW,0))>0)
SET ^SC(DA,"T"_DOW,9999999,1)=""
SET ^(0)=9999999
DO TX^SDB1
if '$DATA(SDRE)
SET SDRE=D0
QUIT
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"
+1 QUIT
PRINT ;Print cancelled days
+1 NEW Y
IF '$DATA(^TMP("SDAVAIL",$JOB))
GOTO PRINTQ
+2 WRITE !,"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"
+3 SET %=1
DO YN^DICN
if %=-1!(%=2)
GOTO PRINTQ
IF %=0
DO HELP
GOTO PRINT
+4 SET %ZIS="PMQ"
DO ^%ZIS
IF POP
GOTO PRINTQ
+5 IF '$DATA(IO("Q"))
GOTO PRINT1
+6 SET Y=$$QUE(0)
GOTO PRINTQ
+7 ;
PRINT1 NEW SDAVAIL,SDLINE
SET SDAVAIL=0
SET $PIECE(SDLINE,"=",80)=""
+1 USE IO
WRITE !,"Dates of Availability Previously Cancelled for "_$EXTRACT($PIECE($GET(^SC(DA,0)),U),1,25),?70,$$FDATE^VALM1(DT),!,SDLINE
+2 FOR
SET SDAVAIL=$ORDER(^TMP("SDAVAIL",$JOB,SDAVAIL))
if 'SDAVAIL
QUIT
Begin DoDot:1
+3 WRITE !,$$FDATE^VALM1(SDAVAIL)_" "_$GET(^TMP("SDAVAIL",$JOB,SDAVAIL))
End DoDot:1
+4 ;
PRINTQ KILL ^TMP("SDAVAIL",$JOB)
+1 if '$DATA(ZTQUEUED)
DO ^%ZISC
+2 QUIT
HELP ;
+1 WRITE !,"Answer 'Y'es or 'N'o."
+2 QUIT
QUE(X) ; -- que job
+1 ; return: did job que [ 1|yes 0|no ]
+2 ;
+3 KILL ZTSK,IO("Q")
+4 SET ZTDESC="Previously Cancelled Availability Dates"
SET ZTRTN="PRINT1^SDB"
+5 FOR
SET X=$ORDER(^TMP("SDAVAIL",$JOB,X))
if 'X
QUIT
Begin DoDot:1
+6 SET ZTSAVE("^TMP(""SDAVAIL"",$J,")=^TMP("SDAVAIL",$JOB,X)
End DoDot:1
+7 SET ZTSAVE("DA")=DA
+8 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE " (Task: ",ZTSK,")"
+9 QUIT $DATA(ZTSK)
