FHQUE ;EPIP/KLD - AUTO-QUEUE DIETETICS REPORTS & LABELS ;04/27/2017 3:31 PM
;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66
; Run shortly after midnight
; Original version June 2004
;ICR# Type Description
;----- ---- --------------------------------------
;2056 Sup GETI^DIQ
;10000 Sup DW^%DTC
;10003 Sup ^%DT
;10006 Sup ^DIC
;10009 Sup ^DICN: FILE, YN
;10013 Sup ^DIK
;10018 Sup ^DIE
;10063 Sup ^%ZTLOAD
;10075 Sup File 19, field .01, read w/Fileman
;10114 Sup File 3.5, field .01, read w/Fileman
;
ST F FHI=0:0 S FHI=$O(^FH(117.024,FHI)) Q:'FHI D:$$GET1^DIQ(117.024,FHI,5)="YES" ML
FHK K %,DA,DIC,DIE,DIK,DR,FH,FHI,FHII,FHIII,FHIEN,FHANS,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("FHQUE",$J) Q
;
ML ;Main loop
S FH("FLAG")=0
I $O(^FH(117.024,FHI,2,0)) D Q:'FH("FLAG") ;Only run certain days of the week
.S X=DT D DW^%DTC S Y=Y+1,FH("FLAG")=$D(^FH(117.024,FHI,2,"B",Y))
S FH("TIME")=$$GET1^DIQ(117.024,FHI,1)
S:FH("TIME")<600 FH("TIME")=0_FH("TIME")
S %DT="R",X="T@"_FH("TIME") D ^%DT S ZTDTH=$S($D(FH("TEST")):$H,1:Y)
S ZTDESC=$$GET1^DIQ(117.024,FHI,.01)_" Auto Queue"
S ZTIO=$$GET1^DIQ(117.024,FHI,2)
S ZTRTN=$$GET1^DIQ(117.024,FHI,3)_U_$$GET1^DIQ(117.024,FHI,4)
F FHII=0:0 S FHII=$O(^FH(117.024,FHI,1,FHII)) Q:'FHII D ;Get necessary variables
.S FH("VAR")=$$GET1^DIQ(117.0242,FHII_","_FHI,.01)
.S @FH("VAR")=$TR($$GET1^DIQ(117.0242,FHII_","_FHI,1),"|",U)
.D:$$GET1^DIQ(117.0242,FHII_","_FHI,2)="YES" ;Date variable
..S X=$TR($$GET1^DIQ(117.0242,FHII_","_FHI,1),"|",U),%DT=$S(X["@":"R",1:"")
..D ^%DT S @FH("VAR")=Y
.S X=$TR($$GET1^DIQ(117.0242,FHII_","_FHI,3),"|",U) X:X]"" X ;Xecutable code to set the variable
.S ZTSAVE(FH("VAR"))=@FH("VAR")
D ^%ZTLOAD W !!,"ZTSK=",$G(ZTSK) Q
;
TEST ;Test one particular option
R !!,"IEN: ",FHI:DTIME Q:U[FHI!'$T S FH("TEST")=""
I FHI["?" S FHIEN=0 F S FHIEN=$O(^FH(117.024,FHIEN)) G:'+FHIEN TEST W !,FHIEN,?10,$P(^FH(117.024,FHIEN,0),"^")
I '$D(^FH(117.024,FHI)) W !,"Invalid IEN!" G TEST
W ! S DIC="^%ZIS(1,",DIC(0)="QEAM",DIC("A")="Select printer: " D ^DIC
G TEST:Y<1 S ZTIO=$P(Y,U,2) D ML,FHK Q
;
UEDIT ;User edit of options
K ^TMP("FHQUE",$J) S FH("CNT")=0,FHI=""
F S FHI=$O(^FH(117.0243,"B",FHI)) Q:FHI="" D
.F FHII=0:0 S FHII=$O(^FH(117.0243,"B",FHI,FHII)) Q:'FHII D
..S X=$$GET1^DIQ(117.0243,FHII,.01) Q:X=""
..S X(1)=$$GET1^DIQ(117.0243,FHII,1) S:X(1)="" X(1)="NULL"
..S DIC(0)="BZ",DIC="^DIC(19," D ^DIC
..S ^TMP("FHQUE",$J,X,X(1))=$P($G(Y(0)),U,2)_U_FHII
S (FHI,FHII)="" W !!,"Available options are:"
F S FHI=$O(^TMP("FHQUE",$J,FHI)) Q:FHI="" D
.F S FHII=$O(^TMP("FHQUE",$J,FHI,FHII)) Q:FHII="" D
..S FH("CNT")=FH("CNT")+1,FH("SEL",FH("CNT"))=FHI_U_$P(^TMP("FHQUE",$J,FHI,FHII),U,2)
..W !?3,$J(FH("CNT"),2),". ",FHI W:FHII'="NULL" ?18,FHII
..W ?32,$P(^TMP("FHQUE",$J,FHI,FHII),U)
UEDIT1 R !,"Your choice, choose by number: ",FH("OPT"):DTIME I U[FH("OPT")!'$T D FHK Q
I FH("OPT")["?" D FHSHOW R !!,?5,"Return to continue: ",FHANS:DTIME Q:'$T G UEDIT
I FH("OPT")'?1.2N!('$D(FH("SEL",FH("OPT")))) W " ??" G UEDIT1
UEDIT2 R !!,"Time to run the option (use 4 digit military time): ",FH("TIME"):DTIME I U[FH("TIME")!'$T D FHK Q
I FH("TIME")'?4N!(FH("TIME")>2359)!($E(FH("TIME"),3)>5) W " ??" G UEDIT2
S FH("NAME")=$P(FH("SEL",FH("OPT")),U)_" "_FH("TIME")
S FH("DA")=$P(FH("SEL",FH("OPT")),U,2)
S (DIC,DIE)="^FH(117.024,",DIC(0)="M",X=FH("NAME") D ^DIC S DA=+Y
I Y=-1 D G UEDIT:%'=1
.W !!,"Add entry ",$C(34),FH("NAME"),$C(34) S %=1 D YN^DICN Q:%'=1
.S DIC(0)="L" K DD,DO D FILE^DICN
.S DA=+Y,DR="1///"_$P(FH("NAME")," ",2),FH("ADDED")=""
.D ^DIE W !,"Entry added."
W !!,"Now add/change the printer and whether it's active.",!
S DR="3///"_$$GET1^DIQ(117.0243,FH("DA"),3)_";4///"_$$GET1^DIQ(117.0243,FH("DA"),4)_";2R;5R//YES;20"
D ^DIE S ^FH(117.024,DA,1,0)="^117.0242^",X=DA
K DA,DIC,DIE,DR S DIC="^FH(117.024,"_X_",1,",DIC(0)="L",DA(1)=X,FH("BAD")=0
F FHI=0:0 S FHI=$O(^FH(117.0243,FH("DA"),1,FHI)) Q:'FHI!(FH("BAD")) D
.S X=$$GET1^DIQ(117.024302,FHI_","_FH("DA"),.01),DIC("DR")=""
.D:$$GET1^DIQ(117.024302,FHI_","_FH("DA"),1)="YES" ASK Q:FH("BAD")
.K DIC("DR"),DD,DO D FILE^DICN S DA=+Y
.S DR="",DIE=DIC D DR,^DIE K FH("QUES")
.S:DR["3//" ^FH(117.024,DA(1),1,DA,1)=$TR(^FH(117.024,DA(1),1,DA,1),"|",U)
I 'FH("BAD") W !!,"Option ",$S($D(FH("ADDED")):"add",1:"chang"),"ed!" H 3
I FH("BAD") S DIK="^FH(117.024," D ^DIK W !!,"Invalid entry - deleted!"
K FH("ADDED") G UEDIT
;
ASK N %DT,FHII,FHWP,X,Y S FHWP=$$GET1^DIQ(117.024302,FHI_","_FH("DA"),5,"","FHWP")
F FHII=0:0 S FHII=$O(FHWP(FHII)) Q:'FHII W !,FHWP(FHII)
R X:DTIME I U[X!'$T S FH("BAD")=1 Q
I FHWP(1)["meal","BNE"'[X W !,"B, N or E" G ASK
I FHWP(1)["meal","BNE"[X S FH("QUES")=$E(X,1) Q
I $$GET1^DIQ(117.024302,FHI_","_FH("DA"),3)="YES" S %DT="ET" D ^%DT I Y<1 W !,"Invalid date/time!" G ASK
S FH("QUES")=X Q
;
DR N X,FHFD S DR=""
F FHFD=1,2,3 D
.I $G(FH("QUES"))]"",FHFD=1 S X=FH("QUES")
.E S X=$$GET1^DIQ(117.024302,FHI_","_FH("DA"),FHFD+1) Q:X=""
.S DR=DR_FHFD_"///"_X_";"
Q
FHSHOW ;Display the print options that have been setup
N FHIEN
W !!,?5,"Print options and times currently set up",!!
S FHIEN="" F S FHIEN=$O(^FH(117.024,FHIEN)) Q:FHIEN="" D
. W !,?5,$P($G(^FH(117.024,FHIEN,0)),U)
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHQUE 5368 printed Dec 13, 2024@01:54:49 Page 2
FHQUE ;EPIP/KLD - AUTO-QUEUE DIETETICS REPORTS & LABELS ;04/27/2017 3:31 PM
+1 ;;5.5;DIETETICS;**43**;Jan 28, 2005;Build 66
+2 ; Run shortly after midnight
+3 ; Original version June 2004
+4 ;ICR# Type Description
+5 ;----- ---- --------------------------------------
+6 ;2056 Sup GETI^DIQ
+7 ;10000 Sup DW^%DTC
+8 ;10003 Sup ^%DT
+9 ;10006 Sup ^DIC
+10 ;10009 Sup ^DICN: FILE, YN
+11 ;10013 Sup ^DIK
+12 ;10018 Sup ^DIE
+13 ;10063 Sup ^%ZTLOAD
+14 ;10075 Sup File 19, field .01, read w/Fileman
+15 ;10114 Sup File 3.5, field .01, read w/Fileman
+16 ;
ST FOR FHI=0:0
SET FHI=$ORDER(^FH(117.024,FHI))
if 'FHI
QUIT
if $$GET1^DIQ(117.024,FHI,5)="YES"
DO ML
FHK KILL %,DA,DIC,DIE,DIK,DR,FH,FHI,FHII,FHIII,FHIEN,FHANS,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("FHQUE",$JOB)
QUIT
+1 ;
ML ;Main loop
+1 SET FH("FLAG")=0
+2 ;Only run certain days of the week
IF $ORDER(^FH(117.024,FHI,2,0))
Begin DoDot:1
+3 SET X=DT
DO DW^%DTC
SET Y=Y+1
SET FH("FLAG")=$DATA(^FH(117.024,FHI,2,"B",Y))
End DoDot:1
if 'FH("FLAG")
QUIT
+4 SET FH("TIME")=$$GET1^DIQ(117.024,FHI,1)
+5 if FH("TIME")<600
SET FH("TIME")=0_FH("TIME")
+6 SET %DT="R"
SET X="T@"_FH("TIME")
DO ^%DT
SET ZTDTH=$SELECT($DATA(FH("TEST")):$HOROLOG,1:Y)
+7 SET ZTDESC=$$GET1^DIQ(117.024,FHI,.01)_" Auto Queue"
+8 SET ZTIO=$$GET1^DIQ(117.024,FHI,2)
+9 SET ZTRTN=$$GET1^DIQ(117.024,FHI,3)_U_$$GET1^DIQ(117.024,FHI,4)
+10 ;Get necessary variables
FOR FHII=0:0
SET FHII=$ORDER(^FH(117.024,FHI,1,FHII))
if 'FHII
QUIT
Begin DoDot:1
+11 SET FH("VAR")=$$GET1^DIQ(117.0242,FHII_","_FHI,.01)
+12 SET @FH("VAR")=$TRANSLATE($$GET1^DIQ(117.0242,FHII_","_FHI,1),"|",U)
+13 ;Date variable
if $$GET1^DIQ(117.0242,FHII_","_FHI,2)="YES"
Begin DoDot:2
+14 SET X=$TRANSLATE($$GET1^DIQ(117.0242,FHII_","_FHI,1),"|",U)
SET %DT=$SELECT(X["@":"R",1:"")
+15 DO ^%DT
SET @FH("VAR")=Y
End DoDot:2
+16 ;Xecutable code to set the variable
SET X=$TRANSLATE($$GET1^DIQ(117.0242,FHII_","_FHI,3),"|",U)
if X]""
XECUTE X
+17 SET ZTSAVE(FH("VAR"))=@FH("VAR")
End DoDot:1
+18 DO ^%ZTLOAD
WRITE !!,"ZTSK=",$GET(ZTSK)
QUIT
+19 ;
TEST ;Test one particular option
+1 READ !!,"IEN: ",FHI:DTIME
if U[FHI!'$TEST
QUIT
SET FH("TEST")=""
+2 IF FHI["?"
SET FHIEN=0
FOR
SET FHIEN=$ORDER(^FH(117.024,FHIEN))
if '+FHIEN
GOTO TEST
WRITE !,FHIEN,?10,$PIECE(^FH(117.024,FHIEN,0),"^")
+3 IF '$DATA(^FH(117.024,FHI))
WRITE !,"Invalid IEN!"
GOTO TEST
+4 WRITE !
SET DIC="^%ZIS(1,"
SET DIC(0)="QEAM"
SET DIC("A")="Select printer: "
DO ^DIC
+5 if Y<1
GOTO TEST
SET ZTIO=$PIECE(Y,U,2)
DO ML
DO FHK
QUIT
+6 ;
UEDIT ;User edit of options
+1 KILL ^TMP("FHQUE",$JOB)
SET FH("CNT")=0
SET FHI=""
+2 FOR
SET FHI=$ORDER(^FH(117.0243,"B",FHI))
if FHI=""
QUIT
Begin DoDot:1
+3 FOR FHII=0:0
SET FHII=$ORDER(^FH(117.0243,"B",FHI,FHII))
if 'FHII
QUIT
Begin DoDot:2
+4 SET X=$$GET1^DIQ(117.0243,FHII,.01)
if X=""
QUIT
+5 SET X(1)=$$GET1^DIQ(117.0243,FHII,1)
if X(1)=""
SET X(1)="NULL"
+6 SET DIC(0)="BZ"
SET DIC="^DIC(19,"
DO ^DIC
+7 SET ^TMP("FHQUE",$JOB,X,X(1))=$PIECE($GET(Y(0)),U,2)_U_FHII
End DoDot:2
End DoDot:1
+8 SET (FHI,FHII)=""
WRITE !!,"Available options are:"
+9 FOR
SET FHI=$ORDER(^TMP("FHQUE",$JOB,FHI))
if FHI=""
QUIT
Begin DoDot:1
+10 FOR
SET FHII=$ORDER(^TMP("FHQUE",$JOB,FHI,FHII))
if FHII=""
QUIT
Begin DoDot:2
+11 SET FH("CNT")=FH("CNT")+1
SET FH("SEL",FH("CNT"))=FHI_U_$PIECE(^TMP("FHQUE",$JOB,FHI,FHII),U,2)
+12 WRITE !?3,$JUSTIFY(FH("CNT"),2),". ",FHI
if FHII'="NULL"
WRITE ?18,FHII
+13 WRITE ?32,$PIECE(^TMP("FHQUE",$JOB,FHI,FHII),U)
End DoDot:2
End DoDot:1
UEDIT1 READ !,"Your choice, choose by number: ",FH("OPT"):DTIME
IF U[FH("OPT")!'$TEST
DO FHK
QUIT
+1 IF FH("OPT")["?"
DO FHSHOW
READ !!,?5,"Return to continue: ",FHANS:DTIME
if '$TEST
QUIT
GOTO UEDIT
+2 IF FH("OPT")'?1.2N!('$DATA(FH("SEL",FH("OPT"))))
WRITE " ??"
GOTO UEDIT1
UEDIT2 READ !!,"Time to run the option (use 4 digit military time): ",FH("TIME"):DTIME
IF U[FH("TIME")!'$TEST
DO FHK
QUIT
+1 IF FH("TIME")'?4N!(FH("TIME")>2359)!($EXTRACT(FH("TIME"),3)>5)
WRITE " ??"
GOTO UEDIT2
+2 SET FH("NAME")=$PIECE(FH("SEL",FH("OPT")),U)_" "_FH("TIME")
+3 SET FH("DA")=$PIECE(FH("SEL",FH("OPT")),U,2)
+4 SET (DIC,DIE)="^FH(117.024,"
SET DIC(0)="M"
SET X=FH("NAME")
DO ^DIC
SET DA=+Y
+5 IF Y=-1
Begin DoDot:1
+6 WRITE !!,"Add entry ",$CHAR(34),FH("NAME"),$CHAR(34)
SET %=1
DO YN^DICN
if %'=1
QUIT
+7 SET DIC(0)="L"
KILL DD,DO
DO FILE^DICN
+8 SET DA=+Y
SET DR="1///"_$PIECE(FH("NAME")," ",2)
SET FH("ADDED")=""
+9 DO ^DIE
WRITE !,"Entry added."
End DoDot:1
if %'=1
GOTO UEDIT
+10 WRITE !!,"Now add/change the printer and whether it's active.",!
+11 SET DR="3///"_$$GET1^DIQ(117.0243,FH("DA"),3)_";4///"_$$GET1^DIQ(117.0243,FH("DA"),4)_";2R;5R//YES;20"
+12 DO ^DIE
SET ^FH(117.024,DA,1,0)="^117.0242^"
SET X=DA
+13 KILL DA,DIC,DIE,DR
SET DIC="^FH(117.024,"_X_",1,"
SET DIC(0)="L"
SET DA(1)=X
SET FH("BAD")=0
+14 FOR FHI=0:0
SET FHI=$ORDER(^FH(117.0243,FH("DA"),1,FHI))
if 'FHI!(FH("BAD"))
QUIT
Begin DoDot:1
+15 SET X=$$GET1^DIQ(117.024302,FHI_","_FH("DA"),.01)
SET DIC("DR")=""
+16 if $$GET1^DIQ(117.024302,FHI_","_FH("DA"),1)="YES"
DO ASK
if FH("BAD")
QUIT
+17 KILL DIC("DR"),DD,DO
DO FILE^DICN
SET DA=+Y
+18 SET DR=""
SET DIE=DIC
DO DR
DO ^DIE
KILL FH("QUES")
+19 if DR["3//"
SET ^FH(117.024,DA(1),1,DA,1)=$TRANSLATE(^FH(117.024,DA(1),1,DA,1),"|",U)
End DoDot:1
+20 IF 'FH("BAD")
WRITE !!,"Option ",$SELECT($DATA(FH("ADDED")):"add",1:"chang"),"ed!"
HANG 3
+21 IF FH("BAD")
SET DIK="^FH(117.024,"
DO ^DIK
WRITE !!,"Invalid entry - deleted!"
+22 KILL FH("ADDED")
GOTO UEDIT
+23 ;
ASK NEW %DT,FHII,FHWP,X,Y
SET FHWP=$$GET1^DIQ(117.024302,FHI_","_FH("DA"),5,"","FHWP")
+1 FOR FHII=0:0
SET FHII=$ORDER(FHWP(FHII))
if 'FHII
QUIT
WRITE !,FHWP(FHII)
+2 READ X:DTIME
IF U[X!'$TEST
SET FH("BAD")=1
QUIT
+3 IF FHWP(1)["meal"
IF "BNE"'[X
WRITE !,"B, N or E"
GOTO ASK
+4 IF FHWP(1)["meal"
IF "BNE"[X
SET FH("QUES")=$EXTRACT(X,1)
QUIT
+5 IF $$GET1^DIQ(117.024302,FHI_","_FH("DA"),3)="YES"
SET %DT="ET"
DO ^%DT
IF Y<1
WRITE !,"Invalid date/time!"
GOTO ASK
+6 SET FH("QUES")=X
QUIT
+7 ;
DR NEW X,FHFD
SET DR=""
+1 FOR FHFD=1,2,3
Begin DoDot:1
+2 IF $GET(FH("QUES"))]""
IF FHFD=1
SET X=FH("QUES")
+3 IF '$TEST
SET X=$$GET1^DIQ(117.024302,FHI_","_FH("DA"),FHFD+1)
if X=""
QUIT
+4 SET DR=DR_FHFD_"///"_X_";"
End DoDot:1
+5 QUIT
FHSHOW ;Display the print options that have been setup
+1 NEW FHIEN
+2 WRITE !!,?5,"Print options and times currently set up",!!
+3 SET FHIEN=""
FOR
SET FHIEN=$ORDER(^FH(117.024,FHIEN))
if FHIEN=""
QUIT
Begin DoDot:1
+4 WRITE !,?5,$PIECE($GET(^FH(117.024,FHIEN,0)),U)
+5 QUIT
End DoDot:1
+6 QUIT
