| [613] | 1 | FHOMSP1 ;Hines OIFO/RTK SPECIAL MEALS PRINT MEAL ;4/11/03 8:05
|
|---|
| 2 | ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
|
|---|
| 3 | ;
|
|---|
| 4 | S STDT=DT,FHS="AP" D LIST^FHOMSS1 W !
|
|---|
| 5 | I NUM=0 W !,"NO AUTHORIZED OR PENDING SPECIAL MEALS TO PRINT" Q
|
|---|
| 6 | K DIR S DIR("A")="Print Which Meal(s)?",DIR(0)="LO^1:"_NUM D ^DIR
|
|---|
| 7 | Q:$D(DIRUT) S FHCLST=Y
|
|---|
| 8 | W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
|
|---|
| 9 | Q:$D(DIRUT) I Y=0 D END Q
|
|---|
| 10 | D DEV Q
|
|---|
| 11 | DEV ;get device and set up queue
|
|---|
| 12 | W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
|
|---|
| 13 | I '$D(IO("Q")) U IO D PRINT,^%ZISC,END Q
|
|---|
| 14 | S ZTRTN="PRINT^FHOMSP1",ZTSAVE("STDT")="",ZTSAVE("FHDFN")=""
|
|---|
| 15 | S ZTSAVE("FHS")="",ZTSAVE("FHCDT")="",ZTSAVE("FHREQPR")=""
|
|---|
| 16 | S ZTSAVE("NUM")="",ZTSAVE("FHCLST")="",ZTSAVE("FHLIST(")=""
|
|---|
| 17 | S ZTDESC="Print Special Meals Voucher" D ^%ZTLOAD
|
|---|
| 18 | D ^%ZISC K %ZIS,IOP
|
|---|
| 19 | D END Q
|
|---|
| 20 | PRINT ;
|
|---|
| 21 | I $G(FHREQPR)=1 D PR2 Q
|
|---|
| 22 | F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHCDT=FHLIST(FHC) D PR2
|
|---|
| 23 | Q
|
|---|
| 24 | PR2 ;
|
|---|
| 25 | S FHDFN=$P(FHCDT,U,1) D PATNAME^FHOMUTL
|
|---|
| 26 | S FHD=$P(FHCDT,U,2),FHNODE=$G(^FHPT(FHDFN,"SM",FHD,0))
|
|---|
| 27 | D ALG^FHCLN S ALG="Allergies : "_$S(ALG="":"NONE ON FILE",1:ALG)
|
|---|
| 28 | S (LNS,UNLNS)="" F FHA=1:1:80 S LNS=LNS_"-",UNLNS=UNLNS_"_"
|
|---|
| 29 | S FHD=$E($$FMTE^XLFDT($P(FHCDT,U,2),"P"),1,12) S X=FHD D TR^FH S FHD=X
|
|---|
| 30 | S FHM=$P(FHNODE,U,9),FHSTAT=$P(FHNODE,U,2)
|
|---|
| 31 | S FHRQR=$P(FHNODE,U,5) S:FHRQR'="" FHRQR=$P($G(^VA(200,FHRQR,0)),U,1)
|
|---|
| 32 | S FHAZR=$P(FHNODE,U,6) S:FHAZR'="" FHAZR=$E($P($G(^VA(200,FHAZR,0)),U,1),1,20)
|
|---|
| 33 | S FHTTL=$P(FHNODE,U,6) S:FHTTL'="" FHTTL=$P($G(^VA(200,FHTTL,0)),U,9) I FHTTL'="" S FHTTL=$E($P($G(^DIC(3.1,FHTTL,0)),U,1),1,24)
|
|---|
| 34 | S FHMEAL=$S(FHM="B":"BREAKFAST",FHM="N":"NOON",1:"EVENING")
|
|---|
| 35 | S FHLPT=$P(FHNODE,U,3),FHLOC=$P($G(^FH(119.6,FHLPT,0)),U,1)
|
|---|
| 36 | S FHRMBD=$P(FHNODE,U,13),FHRMBNM=""
|
|---|
| 37 | I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,24)
|
|---|
| 38 | S FHDPT=$P(FHNODE,U,4),FHDIET=$P($G(^FH(111,FHDPT,0)),U,1)
|
|---|
| 39 | W:$Y @IOF
|
|---|
| 40 | W !!!!,LNS,!?4," A U T H O R I Z E D O U T P A T I E N T M E A L V O U C H E R",!,LNS
|
|---|
| 41 | W !!!,"Name of Pt: ",$E(FHPTNM,1,20)," (",$E(FHPTNM,1,1),FHBID,")"
|
|---|
| 42 | W ?44,"Req Loc : ",$E(FHLOC,1,24)
|
|---|
| 43 | W !,"Start Date: ",FHD,?44,"Room-Bed : ",FHRMBNM
|
|---|
| 44 | W !,"Stop Date : ",FHD,?44,"Requestor: ",$E(FHRQR,1,24),!,ALG
|
|---|
| 45 | W !!?44,"Signature: ",$S(FHSTAT="A":"/es/"_FHAZR,1:$E(UNLNS,1,23))
|
|---|
| 46 | W !!?44," Title: ",$S(FHSTAT="A":FHTTL,1:$E(UNLNS,1,23))
|
|---|
| 47 | W !!?44," Date: ",$S(FHSTAT="A":FHD,1:$E(UNLNS,1,23))
|
|---|
| 48 | W !!!!,"Pt Authorized a: ",FHDIET," Meal for ",FHMEAL," meal time"
|
|---|
| 49 | W !!!!!!!!!!!!,"ALTERING OR COPYING THIS MEAL VOUCHER IS PROHIBITED."
|
|---|
| 50 | W !!!!!!!!!!!!!!!!!!,LNS,!,"In lieu of VA FORM 10-2817",!
|
|---|
| 51 | W !,"Facility: " D SITE^FH W SITE D NOW^%DTC W ?45,$$FMTE^XLFDT(%,"P")
|
|---|
| 52 | W !,LNS
|
|---|
| 53 | Q
|
|---|
| 54 | END ;
|
|---|
| 55 | K FHLPT,FHDPT,FHDIET,FHLOC,FHSTAT,FHRQR,FHTITL,FHAZR,FHMEAL Q
|
|---|
