source: FOIAVistA/trunk/r/DIETETICS-FH/FHWOR5.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1FHWOR5 ; HISC/NCA - HL7 Tubefeeding ;10/10/00 14:57
2 ;;5.5;DIETETICS;**1**;Jan 28, 2005
3 K TUN S (NO,TC,TK,TP,TW,S2)=0,CTR=5
4 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'=""
5 I TXT'="" D ERR^FHWOR Q
6 S (TC,TK)=0 W !
7 F TT=0:0 S TT=$O(TUN(TT)) Q:TT<1 D
8 .S TC=TC+$P(TUN(TT),"^",4)+$P(TUN(TT),"^",5)
9 .S TK=TK+$P(TUN(TT),"^",6) Q
10 I TC>5000 S TXT="WARNING: Total amount exceeds 5000ml. " D ERR^FHWOR Q
11 S FHRDER=+FHORN,CAN=$$CANCEL^ORCDFH(FHRDER),FHRDER=FHORN
12 ; Process TF
13 S FHTF=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",4) I FHTF D ORCAN
14 D ^FHORT11 S $P(^FHPT(FHDFN,"A",ADM,"TF",TF,0),"^",14)=+FHORN
15 S FILL="T"_";"_ADM_";"_TF_";"_TC_";"_TK_";"_TFCOM_";"_CAN D SEND^FHWOR
16 K %,A1,A2,A3,CAN,DATA,DATA1,DIET,DUR,DX,K,FHRDER,FHMSG,FHOL,FHSTR,FHY,QUA,S1,S2,T,TC,TF,TFCOM,TK,TP,TT,TUN,TW,TYP,X
17 Q
18ORCAN ; Cancel Tubefeeding when Order Comes From OE/RR
19 N FHORN,FILL,COM D NOW^%DTC S NOW=%
20 S $P(^FHPT(FHDFN,"A",ADM,0),"^",4)="" K ^FHPT("ADTF",FHDFN,ADM)
21 S $P(^FHPT(FHDFN,"A",ADM,"TF",FHTF,0),"^",11,12)=NOW_"^"_DUZ
22 S FHORN=$P(^FHPT(FHDFN,"A",ADM,"TF",FHTF,0),"^",14)
23 S FHSAV=$G(^FHPT(FHDFN,"A",ADM,"TF",FHTF,0))
24 K % S EVT="T^C^"_FHTF D ^FHORX I FHORN S FILL="T"_";"_ADM_";"_FHTF_";"_$P(FHSAV,"^",6)_";"_$P(FHSAV,"^",7)_";"_$P(FHSAV,"^",5)_";" D CODE D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG,FHSAV,FILL
25 Q
26CAN ; Process Cancel/Discontinue from OE/RR
27 S TF=$P(FILL,";",3) I 'TF D CSEND^FHWOR Q
28 D GADM^FHWORR
29 I '$D(^FHPT(FHDFN,"A",+ADM,"TF",+TF,0)) D CSEND^FHWOR Q
30 D NOW^%DTC S NOW=%
31 I $P($G(^FHPT(FHDFN,"A",ADM,0)),"^",4)'=TF D CSEND^FHWOR Q
32 I $P($G(^FHPT(FHDFN,"A",ADM,0)),"^",4)="" D CSEND^FHWOR Q
33 S $P(^FHPT(FHDFN,"A",ADM,0),"^",4)="" K ^FHPT("ADTF",FHDFN,ADM)
34 S $P(^FHPT(FHDFN,"A",ADM,"TF",TF,0),"^",11,12)=NOW_"^"_DUZ
35 S EVT="T^C^"_TF D ^FHORX K TF
36 S FHRDER=FHORN
37 D CSEND^FHWOR
38 D CUR^FHORD7 Q:Y=""
39 S FHCHK=$$RESUME^FHWORR(DFN) I 'FHCHK K FHDFN,FHRDER Q
40 S FHRES=$$RESUME^ORCDFH(FHRDER) I FHRES D RES K FHRES,FHRDER,FHCHK,FHDFN
41 Q
42RES ; Resume Current Tray Service From OE/RR.
43 N A2,KK,OLD D NOW^%DTC S NOW=%
44 S A2=0 F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1!(KK'<NOW) I $P(^(KK,0),"^",2)=FHORD S A2=KK
45 I 'A2 Q
46 S DT=$P(NOW,".",1),KK=A2,OLD=FHLD D T0^FHORD3
47 K %,%H,%I,A1,A2,C,D1,D2,D3,DA,KK,P2,FHDU,NOW,X1,X2,OLD,FHDR,FHORD,FHPAR,FHLD,FHWF,FHPV,FHOR,I,K9,ADM,ALL,COM,TFCOM,FHDFN,DFN,FHD,POP,PID,BID,DTP,QUA,STR,T,TF,TF2,TUN,WARD,X,X9,Y
48 Q
49TF ; Code Tubefeeding
50 K MSG S FILL="T"_";"_ADM_";"_TF_";"_TC_";"_TK_";"_TFCOM_";"_CAN S MNUM=3
51 S SDT=NOW D SET
52 ; Code MSH, PID, and PV1
53 D MSH^FHWOR
54 ; Code ORC
55 S MNUM=MNUM+1
56 S MSG(MNUM)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
57 Q
58TF1 ; Code Multiple Products ODS and ZQT
59 S STR=$P(XX,"^",2),STR=$S(STR=1:"1/4",STR="2":"1/2",STR=3:"3/4",1:"FULL")_" STRENGTH"
60 S X=$P(XX,"^",3) D FIX^FHORT10 S QUA=X D DECOD
61 S QUA=A1_"&"_$E(A2,1),ITVL=A3,MNUM=MNUM+1
62 S MSG(MNUM)="ODS|ZE||^^^"_+XX_"-"_$P(XX,"^",2)_"^"_$P($G(^FH(118.2,+XX,0)),"^",1)_"^99FHT"_$S(TFCOM'="":"|"_TFCOM,1:"")
63 S MNUM=MNUM+1
64 S MSG(MNUM)="ZQT||"_QUA_"^"_ITVL_"^"_$S(FDG'="":FDG,1:"")_"^"_SDT
65 K A1,A2,A3,FDG,FILL,FHWRD,HOSP,ITVL,L,RM,QUA,SITE,STR,WARD,Z,Z1
66 Q
67DECOD ; Decode Tubefeeding to send
68 S Z1="" F L=1:1:$L(QUA) S Z=$E(QUA,L) I Z'=" " S Z1=Z1_Z
69 F L=1:1:$L(Z1) Q:$E(Z1,L)?1U
70 S A2=$E(Z1,L,99),A1=+$E(Z1,1,L-1)
71 S A3=$P(A2,"/",2),A2=$P(A2,"/",1)
72 I A3'["X" S FDG="" Q
73 S FDG=$P(A3,"X",2),FDG=$S($E(FDG,$L(FDG))="F":"X"_+FDG,1:"H"_+FDG),A3=$P(A3,"X",1)
74 Q
75CODE ; Code Discontinue TF
76 K MSG S ACT="OD" D SITE^FH
77 ; code MSH
78 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
79 ; code PID
80 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
81 ; code ORC
82 S DATE=$$FMTHL7^XLFDT(NOW)
83 S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_FHPV_"|||"_DATE_"|Dietetics Discontinued Tubefeeding order."
84 K ACT,DATE,FILL,SITE
85 Q
86SET ; Set Date/Time in HL7 format
87 S:SDT SDT=$$FMTHL7^XLFDT(SDT)
88 S:NOW NOW=$$FMTHL7^XLFDT(NOW)
89 Q
90NA ; OE/RR Number Assign
91 S TF=+$P(FILL,";",3) Q:'TF S:ADM'=$P(FILL,";",2) ADM=$P(FILL,";",2)
92 G:'+FHORN KIL
93 S $P(^FHPT(FHDFN,"A",ADM,"TF",TF,0),"^",14)=+FHORN
94KIL K MSG,FHORN,TF Q
Note: See TracBrowser for help on using the repository browser.