- FHOMGP1 ;Hines OIFO/RTK PRINT GUEST MEALS LIST ;6/30/03 15:45
- ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- ;
- W @IOF,!!?20,"G U E S T M E A L S L I S T"
- EN ;
- W !! K DIR S DIR("A")="Print by LOCATION, COMM OFFICE, PRODUCTION FACILITY or ALL: "
- S DIR(0)="SAO^A:ALL;C:COMM OFFICE;L:LOCATION;P:PROD FACILITY" D ^DIR
- Q:$D(DIRUT) S FHLBY=Y
- I FHLBY="L" W ! D OUTLOC^FHOMUTL Q:FHLOC="" S FHSELOC=FHLOC,FHLOC=""
- I FHLBY="C" D Q:FHSLCOM=""
- .W ! K DIC S DIC=119.73,DIC("A")="Select Communication Office: "
- .S DIC(0)="AEQZ" D ^DIC Q:$D(DUOUT) I Y=-1 S FHSLCOM="" Q
- .S FHSLCOM=+Y
- I FHLBY="P" D Q:FHSLPRO=""
- .W ! K DIC S DIC=119.71,DIC("A")="Select Production Facility: "
- .S DIC(0)="AEQZ" D ^DIC Q:$D(DUOUT) I Y=-1 S FHSLPRO="" Q
- .S FHSLPRO=+Y
- W ! D STDATE^FHOMUTL I STDT="" Q
- W ! D ENDATE^FHOMUTL I ENDT="" Q
- S ENDT=ENDT_.99
- D DEV,EN Q
- DEV ;get device and set up queue
- W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
- I '$D(IO("Q")) U IO D LIST,^%ZISC,END Q
- S ZTRTN="LIST^FHOMGP1"
- S ZTSAVE("STDT")="",ZTSAVE("ENDT")="",ZTSAVE("FHDFN")=""
- S ZTSAVE("FHLBY")="",ZTSAVE("FHSELOC")="",ZTSAVE("FHSLCOM")="",ZTSAVE("FHSLPRO")=""
- S ZTDESC="Guest Meals Display" D ^%ZTLOAD
- D ^%ZISC K %ZIS,IOP
- D END Q
- LIST ; First build data in ^TMP global
- K ^TMP($J) S NUM=0,EX="",FHPG=0
- F FHGMDT=STDT:0 S FHGMDT=$O(^FHPT("GM",FHGMDT)) Q:FHGMDT'>0!(FHGMDT>ENDT) D
- .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHGMDT,FHDFN)) Q:FHDFN'>0 D
- ..S FHZN=$G(^FHPT(FHDFN,"GM",FHGMDT,0)),FHST=$P(FHZN,U,9) I FHST="C" Q
- ..D PATNAME^FHOMUTL
- ..S FHLOC=$P(FHZN,U,5) Q:FHLOC="" I FHLBY="L",FHSELOC'=FHLOC Q
- ..S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHLBY="C",FHSLCOM'=FHCOMM Q
- ..S FHPRD=$P($G(^FH(119.73,FHCOMM,0)),U,4) I FHLBY="P",FHSLPRO'=FHPRD Q
- ..S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
- ..S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
- ..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1)
- ..S ^TMP($J,FHPRORD_"~"_FHLOCNM,FHGMDT,FHPTNM_"~"_FHDFN)=FHZN
- ..Q
- .Q
- ; Now display data from the ^TMP global
- I '$D(^TMP($J)) W !!,"THERE ARE CURRENTLY NO GUEST MEALS TO PRINT" Q
- S FHLSRT="" F S FHLSRT=$O(^TMP($J,FHLSRT)) Q:FHLSRT=""!(EX=U) D
- .D:FHPG>0&(IOST?1"C".E) PG Q:EX=U
- .D HDR S FHPG=FHPG+1
- .F FHGMDT=0:0 S FHGMDT=$O(^TMP($J,FHLSRT,FHGMDT)) Q:FHGMDT'>0!(EX=U) D
- ..S FHPTN="" F S FHPTN=$O(^TMP($J,FHLSRT,FHGMDT,FHPTN)) Q:FHPTN=""!(EX=U) D
- ...S FHNODE=$G(^TMP($J,FHLSRT,FHGMDT,FHPTN)),FHLOC=$P(FHNODE,U,5)
- ...S FHLOCZN=$G(^FH(119.6,FHLOC,0))
- ...S FHRMBD=$P(FHNODE,U,11),FHRMBNM=""
- ...I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,11)
- ...S FHDFN=$P(FHPTN,"~",2) ;,FHLIST(NUM)=FHDFN_"^"_FHGMDT
- ...S FHCL=$P(FHNODE,U,2),FHML=$P(FHNODE,U,3),FHCH=$P(FHNODE,U,4)
- ...S FHSTAT=$P(FHNODE,U,9),NUM=NUM+1
- ...S FHCL=$S(FHCL="E":"EMP",FHCL="G":"GRAT",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOL")
- ...S FHLOC=$E($P($G(^FH(119.6,FHLOC,0)),U,1),1,12)
- ...; S PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
- ...D PATNAME^FHOMUTL W !,$E(FHPTNM,1,22)
- ...S FHD=$$FMTE^XLFDT(FHGMDT,"P") W ?22,$E(FHD,1,12)
- ...W ?36,FHLOC,?49,FHRMBNM,?62,FHML,?67,FHCL,?74,FHCH
- ...S FHLIST(NUM)=FHDFN_"^"_FHGMDT
- ...I $Y>(IOSL-4) D PG I EX=U Q
- ..Q
- .Q
- Q
- END ;
- K DIR,ENDT,STDT,FHGMDT,FHML,FHCL,FHCH,FHSELOC,FHSLCOM,FHNODE,FHZN
- K FHSLPRO,FHPRD
- Q
- PG ;
- ;Q:$O(^FHPT(FHDFN,"GM",FHGMDT))'>0
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
- D HDR Q
- HDR ;
- W:$Y @IOF
- W !?5,"G U E S T M E A L L I S T"
- W !!?5,"LOCATION: ",$P(FHLSRT,"~",2)
- W !!,"Name",?22,"Date",?36,"Location",?49,"Room-Bed",?61,"Meal"
- W ?67,"Class",?74,"Charge"
- W !,"====================",?22,"============"
- W ?36,"============ ===========",?61,"====",?67,"=====",?74,"======"
- Q
- FHOMGP1 ;Hines OIFO/RTK PRINT GUEST MEALS LIST ;6/30/03 15:45
- +1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- +2 ;
- +3 WRITE @IOF,!!?20,"G U E S T M E A L S L I S T"
- EN ;
- +1 WRITE !!
- KILL DIR
- SET DIR("A")="Print by LOCATION, COMM OFFICE, PRODUCTION FACILITY or ALL: "
- +2 SET DIR(0)="SAO^A:ALL;C:COMM OFFICE;L:LOCATION;P:PROD FACILITY"
- DO ^DIR
- +3 IF $DATA(DIRUT)
- QUIT
- SET FHLBY=Y
- +4 IF FHLBY="L"
- WRITE !
- DO OUTLOC^FHOMUTL
- IF FHLOC=""
- QUIT
- SET FHSELOC=FHLOC
- SET FHLOC=""
- +5 IF FHLBY="C"
- Begin DoDot:1
- +6 WRITE !
- KILL DIC
- SET DIC=119.73
- SET DIC("A")="Select Communication Office: "
- +7 SET DIC(0)="AEQZ"
- DO ^DIC
- IF $DATA(DUOUT)
- QUIT
- IF Y=-1
- SET FHSLCOM=""
- QUIT
- +8 SET FHSLCOM=+Y
- End DoDot:1
- IF FHSLCOM=""
- QUIT
- +9 IF FHLBY="P"
- Begin DoDot:1
- +10 WRITE !
- KILL DIC
- SET DIC=119.71
- SET DIC("A")="Select Production Facility: "
- +11 SET DIC(0)="AEQZ"
- DO ^DIC
- IF $DATA(DUOUT)
- QUIT
- IF Y=-1
- SET FHSLPRO=""
- QUIT
- +12 SET FHSLPRO=+Y
- End DoDot:1
- IF FHSLPRO=""
- QUIT
- +13 WRITE !
- DO STDATE^FHOMUTL
- IF STDT=""
- QUIT
- +14 WRITE !
- DO ENDATE^FHOMUTL
- IF ENDT=""
- QUIT
- +15 SET ENDT=ENDT_.99
- +16 DO DEV
- DO EN
- QUIT
- DEV ;get device and set up queue
- +1 WRITE !
- KILL %ZIS,IOP
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- QUIT
- +2 IF '$DATA(IO("Q"))
- USE IO
- DO LIST
- DO ^%ZISC
- DO END
- QUIT
- +3 SET ZTRTN="LIST^FHOMGP1"
- +4 SET ZTSAVE("STDT")=""
- SET ZTSAVE("ENDT")=""
- SET ZTSAVE("FHDFN")=""
- +5 SET ZTSAVE("FHLBY")=""
- SET ZTSAVE("FHSELOC")=""
- SET ZTSAVE("FHSLCOM")=""
- SET ZTSAVE("FHSLPRO")=""
- +6 SET ZTDESC="Guest Meals Display"
- DO ^%ZTLOAD
- +7 DO ^%ZISC
- KILL %ZIS,IOP
- +8 DO END
- QUIT
- LIST ; First build data in ^TMP global
- +1 KILL ^TMP($JOB)
- SET NUM=0
- SET EX=""
- SET FHPG=0
- +2 FOR FHGMDT=STDT:0
- SET FHGMDT=$ORDER(^FHPT("GM",FHGMDT))
- IF FHGMDT'>0!(FHGMDT>ENDT)
- QUIT
- Begin DoDot:1
- +3 FOR FHDFN=0:0
- SET FHDFN=$ORDER(^FHPT("GM",FHGMDT,FHDFN))
- IF FHDFN'>0
- QUIT
- Begin DoDot:2
- +4 SET FHZN=$GET(^FHPT(FHDFN,"GM",FHGMDT,0))
- SET FHST=$PIECE(FHZN,U,9)
- IF FHST="C"
- QUIT
- +5 DO PATNAME^FHOMUTL
- +6 SET FHLOC=$PIECE(FHZN,U,5)
- IF FHLOC=""
- QUIT
- IF FHLBY="L"
- IF FHSELOC'=FHLOC
- QUIT
- +7 SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
- IF FHLBY="C"
- IF FHSLCOM'=FHCOMM
- QUIT
- +8 SET FHPRD=$PIECE($GET(^FH(119.73,FHCOMM,0)),U,4)
- IF FHLBY="P"
- IF FHSLPRO'=FHPRD
- QUIT
- +9 SET FHPRORD=$PIECE($GET(^FH(119.6,FHLOC,0)),U,4)
- IF FHPRORD=""
- SET FHPRORD=99
- +10 SET FHPRORD=$SELECT(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
- +11 SET FHLOCNM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
- +12 SET ^TMP($JOB,FHPRORD_"~"_FHLOCNM,FHGMDT,FHPTNM_"~"_FHDFN)=FHZN
- +13 QUIT
- End DoDot:2
- +14 QUIT
- End DoDot:1
- +15 ; Now display data from the ^TMP global
- +16 IF '$DATA(^TMP($JOB))
- WRITE !!,"THERE ARE CURRENTLY NO GUEST MEALS TO PRINT"
- QUIT
- +17 SET FHLSRT=""
- FOR
- SET FHLSRT=$ORDER(^TMP($JOB,FHLSRT))
- IF FHLSRT=""!(EX=U)
- QUIT
- Begin DoDot:1
- +18 IF FHPG>0&(IOST?1"C".E)
- DO PG
- IF EX=U
- QUIT
- +19 DO HDR
- SET FHPG=FHPG+1
- +20 FOR FHGMDT=0:0
- SET FHGMDT=$ORDER(^TMP($JOB,FHLSRT,FHGMDT))
- IF FHGMDT'>0!(EX=U)
- QUIT
- Begin DoDot:2
- +21 SET FHPTN=""
- FOR
- SET FHPTN=$ORDER(^TMP($JOB,FHLSRT,FHGMDT,FHPTN))
- IF FHPTN=""!(EX=U)
- QUIT
- Begin DoDot:3
- +22 SET FHNODE=$GET(^TMP($JOB,FHLSRT,FHGMDT,FHPTN))
- SET FHLOC=$PIECE(FHNODE,U,5)
- +23 SET FHLOCZN=$GET(^FH(119.6,FHLOC,0))
- +24 SET FHRMBD=$PIECE(FHNODE,U,11)
- SET FHRMBNM=""
- +25 IF FHRMBD'=""
- SET FHRMBNM=$EXTRACT($PIECE($GET(^DG(405.4,FHRMBD,0)),U,1),1,11)
- +26 ;,FHLIST(NUM)=FHDFN_"^"_FHGMDT
- SET FHDFN=$PIECE(FHPTN,"~",2)
- +27 SET FHCL=$PIECE(FHNODE,U,2)
- SET FHML=$PIECE(FHNODE,U,3)
- SET FHCH=$PIECE(FHNODE,U,4)
- +28 SET FHSTAT=$PIECE(FHNODE,U,9)
- SET NUM=NUM+1
- +29 SET FHCL=$SELECT(FHCL="E":"EMP",FHCL="G":"GRAT",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOL")
- +30 SET FHLOC=$EXTRACT($PIECE($GET(^FH(119.6,FHLOC,0)),U,1),1,12)
- +31 ; S PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
- +32 DO PATNAME^FHOMUTL
- WRITE !,$EXTRACT(FHPTNM,1,22)
- +33 SET FHD=$$FMTE^XLFDT(FHGMDT,"P")
- WRITE ?22,$EXTRACT(FHD,1,12)
- +34 WRITE ?36,FHLOC,?49,FHRMBNM,?62,FHML,?67,FHCL,?74,FHCH
- +35 SET FHLIST(NUM)=FHDFN_"^"_FHGMDT
- +36 IF $Y>(IOSL-4)
- DO PG
- IF EX=U
- QUIT
- End DoDot:3
- +37 QUIT
- End DoDot:2
- +38 QUIT
- End DoDot:1
- +39 QUIT
- END ;
- +1 KILL DIR,ENDT,STDT,FHGMDT,FHML,FHCL,FHCH,FHSELOC,FHSLCOM,FHNODE,FHZN
- +2 KILL FHSLPRO,FHPRD
- +3 QUIT
- PG ;
- +1 ;Q:$O(^FHPT(FHDFN,"GM",FHGMDT))'>0
- +2 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET EX=U
- QUIT
- +3 DO HDR
- QUIT
- HDR ;
- +1 IF $Y
- WRITE @IOF
- +2 WRITE !?5,"G U E S T M E A L L I S T"
- +3 WRITE !!?5,"LOCATION: ",$PIECE(FHLSRT,"~",2)
- +4 WRITE !!,"Name",?22,"Date",?36,"Location",?49,"Room-Bed",?61,"Meal"
- +5 WRITE ?67,"Class",?74,"Charge"
- +6 WRITE !,"====================",?22,"============"
- +7 WRITE ?36,"============ ===========",?61,"====",?67,"=====",?74,"======"
- +8 QUIT
