[613] | 1 | FHOMCBRP ;Hines OIFO/RTK COMBINED OUTPATIENT MEALS LIST ;6/30/03 15:45
|
---|
| 2 | ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
|
---|
| 3 | ;
|
---|
| 4 | W @IOF,!!,"C O M B I N E D O U T P A T I E N T M E A L S L I S T"
|
---|
| 5 | EN ;
|
---|
| 6 | W !! K DIR S DIR("A")="Print by LOCATION, COMM OFFICE, PRODUCTION FACILITY or ALL: "
|
---|
| 7 | S DIR(0)="SAO^A:ALL;C:COMM OFFICE;L:LOCATION;P:PROD FACILITY" D ^DIR
|
---|
| 8 | Q:$D(DIRUT) S FHLBY=Y
|
---|
| 9 | I FHLBY="L" W ! D OUTLOC^FHOMUTL Q:FHLOC="" S FHSELOC=FHLOC,FHLOC=""
|
---|
| 10 | I FHLBY="C" D Q:FHSLCOM=""
|
---|
| 11 | .W ! K DIC S DIC=119.73,DIC("A")="Select Communication Office: "
|
---|
| 12 | .S DIC(0)="AEQZ" D ^DIC Q:$D(DUOUT) I Y=-1 S FHSLCOM="" Q
|
---|
| 13 | .S FHSLCOM=+Y
|
---|
| 14 | I FHLBY="P" D Q:FHSLPRO=""
|
---|
| 15 | .W ! K DIC S DIC=119.71,DIC("A")="Select Production Facility: "
|
---|
| 16 | .S DIC(0)="AEQZ" D ^DIC Q:$D(DUOUT) I Y=-1 S FHSLPRO="" Q
|
---|
| 17 | .S FHSLPRO=+Y
|
---|
| 18 | W ! D STDATE^FHOMUTL I STDT="" Q
|
---|
| 19 | W ! D ENDATE^FHOMUTL I ENDT="" Q
|
---|
| 20 | S X1=STDT,X2=-1 D C^%DTC S STDT1=X,ENDT=ENDT_.99
|
---|
| 21 | D DEV,EN Q
|
---|
| 22 | DEV ;get device and set up queue
|
---|
| 23 | W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
|
---|
| 24 | I '$D(IO("Q")) U IO D LIST,^%ZISC,END Q
|
---|
| 25 | S ZTRTN="LIST^FHOMCBRP",ZTDESC="Combined Outpatient Meals Display"
|
---|
| 26 | S ZTSAVE("STDT")="",ZTSAVE("STDT1")="",ZTSAVE("ENDT")=""
|
---|
| 27 | S ZTSAVE("FHLBY")="",ZTSAVE("FHSELOC")="",ZTSAVE("FHSLCOM")=""
|
---|
| 28 | S ZTSAVE("FHSLPRO")="" D ^%ZTLOAD
|
---|
| 29 | D ^%ZISC K %ZIS,IOP
|
---|
| 30 | D END Q
|
---|
| 31 | LIST ; First build data in ^TMP global
|
---|
| 32 | K ^TMP($J) S NUM=0,EX="",FHPG=0
|
---|
| 33 | ;Recurring Meals
|
---|
| 34 | F FHXRDT=STDT1:0 S FHXRDT=$O(^FHPT("RM",FHXRDT)) Q:FHXRDT'>0!(FHXRDT>ENDT)!(EX=U) D
|
---|
| 35 | .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHXRDT,FHDFN)) Q:FHDFN'>0!(EX=U) D
|
---|
| 36 | ..F FHRM=0:0 S FHRM=$O(^FHPT("RM",FHXRDT,FHDFN,FHRM)) Q:FHRM'>0!(EX=U) D
|
---|
| 37 | ...S FHZN=$G(^FHPT(FHDFN,"OP",FHRM,0)),FHST=$P(FHZN,U,15) I FHST="C" Q
|
---|
| 38 | ...D PATNAME^FHOMUTL
|
---|
| 39 | ...S FHLOC=$P(FHZN,U,3) Q:FHLOC="" I FHLBY="L",FHSELOC'=FHLOC Q
|
---|
| 40 | ...S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHLBY="C",FHSLCOM'=FHCOMM Q
|
---|
| 41 | ...S FHPRD=$P($G(^FH(119.73,FHCOMM,0)),U,4) I FHLBY="P",FHSLPRO'=FHPRD Q
|
---|
| 42 | ...S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
|
---|
| 43 | ...S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
|
---|
| 44 | ...S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1)
|
---|
| 45 | ...S FHML=$P(FHZN,U,4) Q:FHML="" S FHML=$S(FHML="B":1,FHML="N":2,FHML="E":3)
|
---|
| 46 | ...S ^TMP($J,FHXRDT_"~"_FHML,FHPRORD_"~"_FHLOCNM_"~"_FHLOC,FHPTNM_"~"_FHDFN_"~"_FHRM)="R~"_FHZN
|
---|
| 47 | ...Q
|
---|
| 48 | ..Q
|
---|
| 49 | .Q
|
---|
| 50 | ;Special Meals
|
---|
| 51 | S ENDT=ENDT_.99
|
---|
| 52 | F FHSMDT=STDT:0 S FHSMDT=$O(^FHPT("SM",FHSMDT)) Q:FHSMDT'>0!(FHSMDT>ENDT)!(EX=U) D
|
---|
| 53 | .S FHSMDTX=$E(FHSMDT,1,7)
|
---|
| 54 | .S FHDFN=$O(^FHPT("SM",FHSMDT,"")) D PATNAME^FHOMUTL
|
---|
| 55 | .S FHZN=$G(^FHPT(FHDFN,"SM",FHSMDT,0)),FHSTAT=$P(FHZN,U,2)
|
---|
| 56 | .I FHSTAT="C" Q
|
---|
| 57 | .S FHLOC=$P(FHZN,U,3) Q:FHLOC="" I FHLBY="L",FHSELOC'=FHLOC Q
|
---|
| 58 | .S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHLBY="C",FHSLCOM'=FHCOMM Q
|
---|
| 59 | .S FHPRD=$P($G(^FH(119.73,FHCOMM,0)),U,4) I FHLBY="P",FHSLPRO'=FHPRD Q
|
---|
| 60 | .S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
|
---|
| 61 | .S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
|
---|
| 62 | .S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1),FHML=$P(FHZN,U,9) Q:FHML=""
|
---|
| 63 | .S FHML=$S(FHML="B":1,FHML="N":2,FHML="E":3)
|
---|
| 64 | .S ^TMP($J,FHSMDTX_"~"_FHML,FHPRORD_"~"_FHLOCNM_"~"_FHLOC,FHPTNM_"~"_FHDFN)="S~"_FHZN
|
---|
| 65 | .Q
|
---|
| 66 | ;Guest Meals
|
---|
| 67 | F FHGMDT=STDT:0 S FHGMDT=$O(^FHPT("GM",FHGMDT)) Q:FHGMDT'>0!(FHGMDT>ENDT) D
|
---|
| 68 | .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHGMDT,FHDFN)) Q:FHDFN'>0 D
|
---|
| 69 | ..S FHZN=$G(^FHPT(FHDFN,"GM",FHGMDT,0)),FHST=$P(FHZN,U,9) I FHST="C" Q
|
---|
| 70 | ..D PATNAME^FHOMUTL
|
---|
| 71 | ..S FHLOC=$P(FHZN,U,5) Q:FHLOC="" I FHLBY="L",FHSELOC'=FHLOC Q
|
---|
| 72 | ..S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHLBY="C",FHSLCOM'=FHCOMM Q
|
---|
| 73 | ..S FHPRD=$P($G(^FH(119.73,FHCOMM,0)),U,4) I FHLBY="P",FHSLPRO'=FHPRD Q
|
---|
| 74 | ..S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
|
---|
| 75 | ..S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
|
---|
| 76 | ..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1)
|
---|
| 77 | ..S FHML=$P(FHZN,U,3) Q:FHML="" S FHML=$S(FHML="B":1,FHML="N":2,FHML="E":3)
|
---|
| 78 | ..S FHGMDTX=$E(FHGMDT,1,7)
|
---|
| 79 | ..S ^TMP($J,FHGMDTX_"~"_FHML,FHPRORD_"~"_FHLOCNM_"~"_FHLOC,FHPTNM_"~"_FHDFN)="G~"_FHZN
|
---|
| 80 | ..Q
|
---|
| 81 | .Q
|
---|
| 82 | ; Now display data from the ^TMP global
|
---|
| 83 | I '$D(^TMP($J)) W !!,"NO OUTPATIENT MEALS WITHIN SELECTED PARAMETERS" Q
|
---|
| 84 | S FHDTML="" F S FHDTML=$O(^TMP($J,FHDTML)) Q:FHDTML=""!(EX=U) D
|
---|
| 85 | .I FHPG<1 D HDR
|
---|
| 86 | .S FHWDT=$P(FHDTML,"~",1),FHWML=$P(FHDTML,"~",2)
|
---|
| 87 | .S FHWDT=$$FMTE^XLFDT(FHWDT,"P")
|
---|
| 88 | .S FHWML=$S(FHWML=1:"Breakfast",FHWML=2:"Noon",1:"Evening")
|
---|
| 89 | .S FHPG=FHPG+1
|
---|
| 90 | .S FHLOC="" F S FHLOC=$O(^TMP($J,FHDTML,FHLOC)) Q:FHLOC=""!(EX=U) D
|
---|
| 91 | ..W !!,FHWDT,?14,"- ",FHWML,?28,"LOCATION: "
|
---|
| 92 | ..W $P(FHLOC,"~",2),!,"Patient Name",?28,"Diet",?55,"Room-Bed"
|
---|
| 93 | ..W !,"========================",?28,"========================"
|
---|
| 94 | ..W ?55,"========================"
|
---|
| 95 | ..S FHPTN="" F S FHPTN=$O(^TMP($J,FHDTML,FHLOC,FHPTN)) Q:FHPTN=""!(EX=U) D
|
---|
| 96 | ...S FHNODE=$G(^TMP($J,FHDTML,FHLOC,FHPTN))
|
---|
| 97 | ...W !,$E($P(FHPTN,"~",1),1,24)
|
---|
| 98 | ...S FHPCE=2 S:$E(FHNODE,1)="S" FHPCE=4 S:$E(FHNODE,1)="G" FHPCE=6
|
---|
| 99 | ...S FHDIET=$P(FHNODE,U,FHPCE)
|
---|
| 100 | ...I FHDIET'="" W ?28,$E($P($G(^FH(111,FHDIET,0)),U,1),1,24)
|
---|
| 101 | ...I $E(FHNODE,1)="R" I $P($G(^FH(119.6,$P(FHLOC,"~",3),1)),U,4)="Y" S FHDFN=$P(FHPTN,"~",2),FHRNUM=$P(FHPTN,"~",3) D DIETPAT^FHOMRR1 W ?28,$E(FHDIETP,1,24)
|
---|
| 102 | ...S FHPCE=18 S:$E(FHNODE,1)="S" FHPCE=13 S:$E(FHNODE,1)="G" FHPCE=11
|
---|
| 103 | ...S FHRMBD=$P(FHNODE,U,FHPCE),FHRMBNM=""
|
---|
| 104 | ...I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,24)
|
---|
| 105 | ...W ?55,FHRMBNM
|
---|
| 106 | ...I $Y>(IOSL-4) D PG I EX=U Q
|
---|
| 107 | ...Q
|
---|
| 108 | ..Q
|
---|
| 109 | .Q
|
---|
| 110 | Q
|
---|
| 111 | END ;
|
---|
| 112 | K DIR,ENDT,STDT,FHGMDT,FHGMDTX,FHRM,FHXRDT,FHSMDT,FHSMDTX,FHML,FHCL
|
---|
| 113 | K FHCH,FHDIET,FHLOC,FHPTN,FHSELOC,FHSLCOM,FHNODE,FHZN,FHSLPRO,FHPRD
|
---|
| 114 | K FHDIETP,FHPCE,FHPG
|
---|
| 115 | Q
|
---|
| 116 | PG ;
|
---|
| 117 | I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
|
---|
| 118 | D HDR Q
|
---|
| 119 | HDR ;
|
---|
| 120 | W:$Y @IOF
|
---|
| 121 | W !,"C O M B I N E D O U T P A T I E N T M E A L S L I S T",!!
|
---|
| 122 | Q
|
---|