1 | FHOMRT1 ;Hines OIFO/RTK OUTPATIENT MEALS TUBEFEEDING ORDERS ;6/02/03 14:15
|
---|
2 | ;;5.5;DIETETICS;**1,2**;Jan 28, 2005
|
---|
3 | ;
|
---|
4 | S FHMSG1="T" D GETOPT^FHOMUTL I FHFIND=0 Q
|
---|
5 | K NUM D DISP^FHOMRR1 I $G(NUM)="" Q
|
---|
6 | TF1 W ! K DIR S DIR("A")="Select Order(s)",DIR(0)="LO^1:"_NUM D ^DIR
|
---|
7 | Q:$D(DIRUT) S FHCLST=Y
|
---|
8 | S FHCAN1=0 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=FHLIST(FHC) I $P($G(^FHPT(FHDFN,"OP",+FHRNUM,0)),U,15)'="C" S FHCAN1=1
|
---|
9 | I FHCAN1=0 W !!?3,"The selected order(s) have been cancelled!",! D TF1 Q
|
---|
10 | FHTUB K TUN S NO=0,FHWF=$S($D(^ORD(101)):1,1:0) D ^FHORT10
|
---|
11 | I $O(TUN(0))="" D EXMSG^FHOMUTL Q
|
---|
12 | S (FHTC,FHTK)=0,FHORN="" W !
|
---|
13 | F FHK=0:0 S FHK=$O(TUN(FHK)) Q:FHK<1 D
|
---|
14 | .S FHTC=FHTC+$P(TUN(FHK),"^",4)+$P(TUN(FHK),"^",5)
|
---|
15 | .S FHTK=FHTK+$P(TUN(FHK),"^",6),FHSTR=$P(TUN(FHK),"^",2)
|
---|
16 | .S FHPRO=$P(TUN(FHK),"^",1)
|
---|
17 | .W !,"Product: ",$P($G(^FH(118.2,FHPRO,0)),"^",1),", "
|
---|
18 | .W $S(FHSTR=4:"Full",FHSTR=2:"1/2",FHSTR=1:"1/4",1:"3/4"),", "
|
---|
19 | .W $P(TUN(FHK),"^",3)
|
---|
20 | .Q
|
---|
21 | W !!,"Total Kcal: ",FHTK,?36,"Total Quantity: ",FHTC
|
---|
22 | I FHTC>5000 W !!,"WARNING: Total amount exceeds 5000ml: ",FHTC," ml",!,"Please Edit the Tubefeeding and Modify." D FHTUB Q
|
---|
23 | ;
|
---|
24 | W ! K DIR S DIR("A")="Tubefeeding Comment: ",DIR(0)="FAO^1:160" D ^DIR
|
---|
25 | I Y="^" D EXMSG^FHOMUTL Q
|
---|
26 | S FHTEXT=Y
|
---|
27 | W ! K DIR S DIR("A")="Is this correct?: ",DIR(0)="YA",DIR("B")="Y"
|
---|
28 | D ^DIR I $D(DIRUT)!(Y=0) D EXMSG^FHOMUTL,END Q
|
---|
29 | W !
|
---|
30 | F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=FHLIST(FHC) D CHK
|
---|
31 | D OKMSG^FHOMUTL Q
|
---|
32 | D END Q
|
---|
33 | CHK ;
|
---|
34 | I $P($G(^FHPT(FHDFN,"OP",+FHRNUM,0)),U,15)="C" S FHDTX=$P(FHRNUM,U,2),FHDTX=$$FMTE^XLFDT(FHDTX,"P") W !?3,"The order for ",$E(FHDTX,1,12)," has been cancelled -- not ordered!" Q
|
---|
35 | D SET,UPD100
|
---|
36 | Q
|
---|
37 | SET ;
|
---|
38 | K ^FHPT(FHDFN,"OP",+FHRNUM,"TF") S FHEV=""
|
---|
39 | S FHORN=$S($G(FHORN)="":"",1:FHORN)
|
---|
40 | K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=+FHRNUM
|
---|
41 | S DR="18////^S X=FHTEXT;20////^S X=FHTC;21////^S X=FHTK;21.5////^S X=FHORN;21.7////^S X=DUZ" D ^DIE
|
---|
42 | F K=0:0 S K=$O(TUN(K)) Q:K<1 D
|
---|
43 | .S Y=K K DIC,DO S DA(2)=FHDFN,DA(1)=+FHRNUM
|
---|
44 | .S DIC="^FHPT("_DA(2)_",""OP"","_DA(1)_",""TF"","
|
---|
45 | .S DIC(0)="L",DIC("P")=$P(^DD(115.016,19,0),U,2),X=+Y,DINUM=X
|
---|
46 | .D FILE^DICN I Y=-1 Q
|
---|
47 | .K DIE S DA(2)=FHDFN,DA(1)=+FHRNUM,DA=+Y
|
---|
48 | .S FH1=$P(TUN(K),U,2),FH2=$P(TUN(K),U,3),FH3=$P(TUN(K),U,4)
|
---|
49 | .S FH4=$P(TUN(K),U,5),FH5=$P(TUN(K),U,6)
|
---|
50 | .S DIE="^FHPT("_DA(2)_",""OP"","_DA(1)_",""TF"","
|
---|
51 | .S DR="1////^S X=FH1;2////^S X=FH2;3////^S X=FH3;4////^S X=FH4;5////^S X=FH5" D ^DIE
|
---|
52 | .S X3=TUN(K),TUN=$P(X3,U,1),XX=$G(^FH(118.2,TUN,0)) D CALC^FHORX3
|
---|
53 | .S FHEV=FHEV_P2_" "_$P(XX,"^",1)_", "
|
---|
54 | .Q
|
---|
55 | S FHACT="O",FHOPTY="T",FHAET=$E(FHEV,1,$L(FHEV)-2) D SETAET^FHOMRO2
|
---|
56 | Q
|
---|
57 | END ;
|
---|
58 | K A,FHFIND,FHCLST,FHC,FHRNUM,FHTEXT,FHTODAY,NUM Q
|
---|
59 | Q
|
---|
60 | HL7SET ;
|
---|
61 | ; Entry point for TF's placed from CPRS/OERR
|
---|
62 | K TUN S (NO,TC,TK,TP,TW,S2)=0,CTR=5
|
---|
63 | F NUM=1:1:5 S DATA=$G(FHMSG(CTR)) Q:DATA="" S CTR=CTR+1,DATA1=$G(FHMSG(CTR)) Q:DATA1="" D ^FHWOR51 S CTR=CTR+1 Q:TXT'=""
|
---|
64 | I TXT'="" D ERR^FHOMWOR Q
|
---|
65 | I $O(TUN(0))="" Q
|
---|
66 | S (FHCOND,FHTC,FHTK)=0,FHTEXT=$E($P(DATA,"|",5),1,160)
|
---|
67 | F FHK=0:0 S FHK=$O(TUN(FHK)) Q:FHK<1!(FHCOND=1) D
|
---|
68 | .I '$D(^FH(118.2,FHK)) S FHCOND=1 Q
|
---|
69 | .S FHTC=FHTC+$P(TUN(FHK),"^",4)+$P(TUN(FHK),"^",5)
|
---|
70 | .S FHTK=FHTK+$P(TUN(FHK),"^",6)
|
---|
71 | .Q
|
---|
72 | I FHCOND=1 S TXT="Invalid TF Product" D GETOR^FHWOR,ERR^FHOMWOR Q
|
---|
73 | I FHTC>5000 S TXT="Total amount exceeds 5000ml" D ERR^FHOMWOR Q
|
---|
74 | S X1=STDT,X2=-1 D C^%DTC S STDT1=X
|
---|
75 | F FHRMDT=STDT1:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>ENDT) F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0 D SET
|
---|
76 | I '$D(FHRNUM) Q
|
---|
77 | S FILL="T;"_FHRNUM_";"_FHTK_";"_FHTC_";"_FHTEXT_";"_FHORN
|
---|
78 | D SEND^FHWOR Q
|
---|
79 | UPD100 ;Backdoor message to update file #100 with a new TF order
|
---|
80 | Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
---|
81 | Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
|
---|
82 | S FILL="T;"_FHRNUM,MNUM=4,TFCOM=FHTEXT D NOW^%DTC S FHNOW=%
|
---|
83 | S (FHODT,SDT)=$P(FHRNUM,U,2),FHODT=$$FMTHL7^XLFDT(FHODT)
|
---|
84 | S MSG(MNUM)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"|||"_DUZ_"||"_DUZ_"|||"_FHNOW
|
---|
85 | F FHTF=0:0 S FHTF=$O(TUN(FHTF)) Q:FHTF<1 S XX=$G(TUN(FHTF)) D TF1^FHWOR5
|
---|
86 | D EVSEND^FHWOR
|
---|
87 | Q
|
---|