- 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 Feb 19, 2025@00:15:01 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)