- FHMTK1 ; HISC/REL/NCA - Tray Tickets ;4/20/95 15:28
- ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- F0 ;
- K FHOMF,DFN,IEN200 S FHBY="",FHTTDFN=0
- K DIR S DIR(0)="SBAO^P:Patient;C:Communication Office;L:Location;A:All"
- S DIR("B")="COMM"
- S DIR("A")="Print by PATIENT, COMMUNICATION OFFICE, LOCATION or ALL? "
- D ^DIR I $D(DIRUT) D KIL Q
- S FHBY=Y
- I FHBY="P" D P0 Q
- I FHBY="C" D C0 Q
- I FHBY="L" D NL0 Q
- I FHBY="A" S (DFN,FHP,W1)="" D S0 Q
- Q
- C0 ; Sort by Communication Office
- S FHP=$O(^FH(119.73,0))
- I FHP'<1,$O(^FH(119.73,FHP))<1 S (DFN,W1)="" G S0
- K DIC S DIC="^FH(119.73,",DIC("A")="Select COMMUNICATION OFFICE: "
- S DIC(0)="AEQM" W ! D ^DIC K DIC
- G KIL:"^"[X!$D(DTOUT),C0:Y<1 S FHP=+Y,(DFN,W1)="" G S0
- NL0 ; Sort by Location
- K DIC S DIC="^FH(119.6,",DIC("A")="Select NUTRITION LOCATION: "
- S DIC(0)="AEQM" W ! D ^DIC K DIC
- G KIL:"^"[X!$D(DTOUT),NL0:Y<1 S W1=+Y,(DFN,FHP)="" G S0
- P0 ; Single patient
- S FHALL=1 D ^FHOMDPA S FHTTDFN=FHDFN I 'FHDFN D KIL Q
- I 'DFN D P1 Q
- I $G(^DPT(DFN,.1))="" D P1 Q
- S (FHP,W1)="",SRT="R" G F1
- I $P($G(^DPT(DFN,.35)),"^",1) W !!?5," [ Patient has expired. ]" G KIL
- S0 ; Start
- I $G(TABREC)="YES" S SRT="A" G F1
- R !!,"Sort Patients: (A=Alphabetically R=Room-Bed) R// ",SRT:DTIME G:'$T!(SRT["^") KIL S:SRT="" SRT="R" I "ar"[SRT S X=SRT D TR^FH S SRT=X
- I SRT'?1U!("AR"'[SRT) W *7," Enter A or R" G S0
- F1 S %DT("A")="Select Date: ",%DT="AEFX",%DT("B")="TODAY",%DT(0)=DT W ! D ^%DT G KIL:"^"[X!$D(DTOUT),F1:Y<1 S (X1,D1)=+Y
- D E1^FHPRC1 I FHCY<1 W *7,!!,"No MENU CYCLE Defined for that Date!" G F1
- I '$D(^FH(116,FHCY,"DA",FHDA,0)) W *7,!!,"MENU CYCLE DAY Not Defined for that Date!" G F1
- R1 R !!,"Select MEAL (B,N,E,or ALL): ",MEAL:DTIME G:'$T!("^"[MEAL) KIL S X=MEAL D TR^FH S MEAL=X S:$P("ALL",MEAL,1)="" MEAL="A"
- I "BNEA"'[MEAL!(MEAL'?1U) W *7,!,"Select B for Breakfast, N for Noon, or E for Evening or ALL for all meals" G R1
- S FHOMEAL=MEAL,FHDA=^FH(116,FHCY,"DA",FHDA,0)
- I $D(^FH(116.3,D1,0)) S X=^(0) F LL=2:1:4 I $P(X,"^",LL) S $P(FHDA,"^",LL)=$P(X,"^",LL)
- I MEAL="A" F LP="B","N","E" S FHX1=$P(FHDA,"^",$F("BNE",LP)) I 'FHX1 W *7,!!,"*** NO MENU DEFINED FOR ",$S(LP="B":"BREAKFAST",LP="N":"NOON",1:"EVENING")," ***" G KIL
- S (SUM,UPD)=0 G:MEAL="A" D5
- S FHX1=$P(FHDA,"^",$F("BNE",MEAL)) I 'FHX1 W *7,!!,"*** NO MENU DEFINED FOR THIS MEAL ***" G KIL
- ;I $G(IEN200)'="",$G(FHOMF)=1 Q
- G L0:DFN,R2
- D5 G:DFN!($G(IEN200)'="") L0 R !!,"Consolidated List? Y// ",X:DTIME G:'$T!(X="^") KIL S:X="" X="Y" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G D5
- S SUM=X?1"Y".E
- R2 I $G(TABREC)="YES" G L0
- R !!,"Print Only Ones With Order Changes related to the Tray Ticket? N // ",X:DTIME G:'$T!(X="^") KIL S:X="" X="N" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7,!," Answer YES or NO" G R2
- S UPD=X?1"Y".E
- L0 ;I $G(FHOMF)=1 Q
- W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
- I $D(IO("Q")) S FHPGM="B1^FHMTK1A",FHLST="D1^MEAL^IEN200^FHOMEAL^FHOMF^FHBY^FHDFN^FHTTDFN^FHX1^FHP^W1^DFN^FHDA^SUM^UPD^SRT^TABREC" D EN2^FH G KIL
- U IO D B1^FHMTK1A D ^%ZISC K %ZIS,IOP G KIL
- KIL K ^TMP($J),TABREC G KILL^XUSCLEAN
- ;
- TABREC ; Entry point for separate Print Tab Recipes option
- S TABREC="YES" D F0
- K TABREC Q
- P1 ; Tray tickets for single outpatient
- S (FHP,W1)="",SRT="R",FHOMF=1,NBR=0,MFLG=0
- S FHBOT=$P($G(^FH(119.9,1,4)),"^",1) D F1
- S LN=$S(IOST?1"C".E:IOSL-2,1:IOSL-6),SL=40
- I '$D(MEAL) Q
- I MEAL="A" S MFLG=1
- D ^FHOMTK1 Q
- Q
- FHMTK1 ; HISC/REL/NCA - Tray Tickets ;4/20/95 15:28
- +1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- F0 ;
- +1 KILL FHOMF,DFN,IEN200
- SET FHBY=""
- SET FHTTDFN=0
- +2 KILL DIR
- SET DIR(0)="SBAO^P:Patient;C:Communication Office;L:Location;A:All"
- +3 SET DIR("B")="COMM"
- +4 SET DIR("A")="Print by PATIENT, COMMUNICATION OFFICE, LOCATION or ALL? "
- +5 DO ^DIR
- IF $DATA(DIRUT)
- DO KIL
- QUIT
- +6 SET FHBY=Y
- +7 IF FHBY="P"
- DO P0
- QUIT
- +8 IF FHBY="C"
- DO C0
- QUIT
- +9 IF FHBY="L"
- DO NL0
- QUIT
- +10 IF FHBY="A"
- SET (DFN,FHP,W1)=""
- DO S0
- QUIT
- +11 QUIT
- C0 ; Sort by Communication Office
- +1 SET FHP=$ORDER(^FH(119.73,0))
- +2 IF FHP'<1
- IF $ORDER(^FH(119.73,FHP))<1
- SET (DFN,W1)=""
- GOTO S0
- +3 KILL DIC
- SET DIC="^FH(119.73,"
- SET DIC("A")="Select COMMUNICATION OFFICE: "
- +4 SET DIC(0)="AEQM"
- WRITE !
- DO ^DIC
- KILL DIC
- +5 IF "^"[X!$DATA(DTOUT)
- GOTO KIL
- IF Y<1
- GOTO C0
- SET FHP=+Y
- SET (DFN,W1)=""
- GOTO S0
- NL0 ; Sort by Location
- +1 KILL DIC
- SET DIC="^FH(119.6,"
- SET DIC("A")="Select NUTRITION LOCATION: "
- +2 SET DIC(0)="AEQM"
- WRITE !
- DO ^DIC
- KILL DIC
- +3 IF "^"[X!$DATA(DTOUT)
- GOTO KIL
- IF Y<1
- GOTO NL0
- SET W1=+Y
- SET (DFN,FHP)=""
- GOTO S0
- P0 ; Single patient
- +1 SET FHALL=1
- DO ^FHOMDPA
- SET FHTTDFN=FHDFN
- IF 'FHDFN
- DO KIL
- QUIT
- +2 IF 'DFN
- DO P1
- QUIT
- +3 IF $GET(^DPT(DFN,.1))=""
- DO P1
- QUIT
- +4 SET (FHP,W1)=""
- SET SRT="R"
- GOTO F1
- +5 IF $PIECE($GET(^DPT(DFN,.35)),"^",1)
- WRITE !!?5," [ Patient has expired. ]"
- GOTO KIL
- S0 ; Start
- +1 IF $GET(TABREC)="YES"
- SET SRT="A"
- GOTO F1
- +2 READ !!,"Sort Patients: (A=Alphabetically R=Room-Bed) R// ",SRT:DTIME
- IF '$TEST!(SRT["^")
- GOTO KIL
- IF SRT=""
- SET SRT="R"
- IF "ar"[SRT
- SET X=SRT
- DO TR^FH
- SET SRT=X
- +3 IF SRT'?1U!("AR"'[SRT)
- WRITE *7," Enter A or R"
- GOTO S0
- F1 SET %DT("A")="Select Date: "
- SET %DT="AEFX"
- SET %DT("B")="TODAY"
- SET %DT(0)=DT
- WRITE !
- DO ^%DT
- IF "^"[X!$DATA(DTOUT)
- GOTO KIL
- IF Y<1
- GOTO F1
- SET (X1,D1)=+Y
- +1 DO E1^FHPRC1
- IF FHCY<1
- WRITE *7,!!,"No MENU CYCLE Defined for that Date!"
- GOTO F1
- +2 IF '$DATA(^FH(116,FHCY,"DA",FHDA,0))
- WRITE *7,!!,"MENU CYCLE DAY Not Defined for that Date!"
- GOTO F1
- R1 READ !!,"Select MEAL (B,N,E,or ALL): ",MEAL:DTIME
- IF '$TEST!("^"[MEAL)
- GOTO KIL
- SET X=MEAL
- DO TR^FH
- SET MEAL=X
- IF $PIECE("ALL",MEAL,1)=""
- SET MEAL="A"
- +1 IF "BNEA"'[MEAL!(MEAL'?1U)
- WRITE *7,!,"Select B for Breakfast, N for Noon, or E for Evening or ALL for all meals"
- GOTO R1
- +2 SET FHOMEAL=MEAL
- SET FHDA=^FH(116,FHCY,"DA",FHDA,0)
- +3 IF $DATA(^FH(116.3,D1,0))
- SET X=^(0)
- FOR LL=2:1:4
- IF $PIECE(X,"^",LL)
- SET $PIECE(FHDA,"^",LL)=$PIECE(X,"^",LL)
- +4 IF MEAL="A"
- FOR LP="B","N","E"
- SET FHX1=$PIECE(FHDA,"^",$FIND("BNE",LP))
- IF 'FHX1
- WRITE *7,!!,"*** NO MENU DEFINED FOR ",$SELECT(LP="B":"BREAKFAST",LP="N":"NOON",1:"EVENING")," ***"
- GOTO KIL
- +5 SET (SUM,UPD)=0
- IF MEAL="A"
- GOTO D5
- +6 SET FHX1=$PIECE(FHDA,"^",$FIND("BNE",MEAL))
- IF 'FHX1
- WRITE *7,!!,"*** NO MENU DEFINED FOR THIS MEAL ***"
- GOTO KIL
- +7 ;I $G(IEN200)'="",$G(FHOMF)=1 Q
- +8 IF DFN
- GOTO L0
- GOTO R2
- D5 IF DFN!($GET(IEN200)'="")
- GOTO L0
- READ !!,"Consolidated List? Y// ",X:DTIME
- IF '$TEST!(X="^")
- GOTO KIL
- IF X=""
- SET X="Y"
- DO TR^FH
- IF $PIECE("YES",X,1)'=""
- IF $PIECE("NO",X,1)'=""
- WRITE *7," Answer YES or NO"
- GOTO D5
- +1 SET SUM=X?1"Y".E
- R2 IF $GET(TABREC)="YES"
- GOTO L0
- +1 READ !!,"Print Only Ones With Order Changes related to the Tray Ticket? N // ",X:DTIME
- IF '$TEST!(X="^")
- GOTO KIL
- IF X=""
- SET X="N"
- DO TR^FH
- IF $PIECE("YES",X,1)'=""
- IF $PIECE("NO",X,1)'=""
- WRITE *7,!," Answer YES or NO"
- GOTO R2
- +2 SET UPD=X?1"Y".E
- L0 ;I $G(FHOMF)=1 Q
- +1 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select LIST Printer: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- IF POP
- GOTO KIL
- +2 IF $DATA(IO("Q"))
- SET FHPGM="B1^FHMTK1A"
- SET FHLST="D1^MEAL^IEN200^FHOMEAL^FHOMF^FHBY^FHDFN^FHTTDFN^FHX1^FHP^W1^DFN^FHDA^SUM^UPD^SRT^TABREC"
- DO EN2^FH
- GOTO KIL
- +3 USE IO
- DO B1^FHMTK1A
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- KIL KILL ^TMP($JOB),TABREC
- GOTO KILL^XUSCLEAN
- +1 ;
- TABREC ; Entry point for separate Print Tab Recipes option
- +1 SET TABREC="YES"
- DO F0
- +2 KILL TABREC
- QUIT
- P1 ; Tray tickets for single outpatient
- +1 SET (FHP,W1)=""
- SET SRT="R"
- SET FHOMF=1
- SET NBR=0
- SET MFLG=0
- +2 SET FHBOT=$PIECE($GET(^FH(119.9,1,4)),"^",1)
- DO F1
- +3 SET LN=$SELECT(IOST?1"C".E:IOSL-2,1:IOSL-6)
- SET SL=40
- +4 IF '$DATA(MEAL)
- QUIT
- +5 IF MEAL="A"
- SET MFLG=1
- +6 DO ^FHOMTK1
- QUIT
- +7 QUIT