source: FOIAVistA/tag/r/DIETETICS-FH/FHOMWOR.m@ 1005

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1FHOMWOR ;Hines OIFO/RTK OUTPATIENT MEALS/HL7 MESSAGING ;10/21/03 10:15
2 ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
3 S FHDFN="",FHZ115="P"_DFN D ADD^FHOMDPA
4 I 'FHDFN S TXT="Outpatient not found" D GETOR^FHWOR,ERR Q
5 ;Decode FHMSG(3) - PV1
6 S FHX=$G(FHMSG(3))
7 I $E(FHX,1,3)'="PV1" S TXT="3rd msg not PV1" D GETOR^FHWOR,ERR Q
8 S FHLOC=$P($P(FHX,"|",4),U,1)
9 I FHLOC="" S TXT="Missing Location" D GETOR^FHWOR,ERR Q
10 S FHLOC=$O(^FH(119.6,"AL",FHLOC,""))
11 I 'FHLOC S TXT="Invalid Location" D GETOR^FHWOR,ERR Q
12 ;Decode FHMSG(4) - ORC
13 S FHX=$G(FHMSG(4))
14 I $E(FHX,1,3)'="ORC" S TXT="4th msg not ORC" D GETOR^FHWOR,ERR Q
15 S FHORN=$P(FHX,"|",3),FHORN=+FHORN,FILL=$P(FHX,"|",4)
16 S FHDUR=$P(FHX,"|",8),FHDOW=$P(FHDUR,U,2)
17 S DATE=$E($P(FHDUR,U,4),1,8) D CVT^FHWOR S STDT=DATE,FHOSTDT=STDT
18 S DATE=$P(FHDUR,U,5) D CVT^FHWOR S ENDT=DATE I ENDT'="" S ENDT=ENDT_.99
19 I ENDT="" S ENDT=9999999.99
20 S ACT=$P(FHX,"|",2) I ACT="CA"!(ACT="DC") D CANCEL Q
21 I ACT="NA" D NA Q
22 I ACT="SS" D OMSTAT^FHWORR Q
23 I ACT'="NW" S TXT="Action not NW, CA or DC" D GETOR^FHWOR,ERR Q
24 D NOW^%DTC S FHNOW=$P(%,".",1)
25 I STDT=""!(STDT<FHNOW) S TXT="Start Date not valid" D GETOR^FHWOR,ERR Q
26 I ENDT<STDT S TXT="End Date not valid" D GETOR^FHWOR,ERR Q
27 S FHPV=$P(FHX,"|",13),FHEFF=$P(FHX,"|",16)
28 I FHEFF="" S TXT="No effective date" D ERR Q
29 ;Decode FHMSG(5) - ODS/ODT
30 S FHX=$G(FHMSG(5))
31 S FHINST=$P(FHX,"|",4),FHBAG="N" I FHINST="bagged" S FHBAG="Y"
32 S FHSVCP=$P($P(FHX,"|",3),U,4)
33 I $E(FHX,1,3)="ODT" D HL7SET^FHOMRE1 Q ;EARLY/LATE
34 I $E(FHX,1,3)="OBR" D HL7SET^FHOMIP Q ;ISOLATION/PRECAUTION
35 I $E(FHX,1,3)'="ODS" S TXT="5th message not ODT or ODS as expected" D GETOR^FHWOR,ERR Q
36 S FHTYPC=$P(FHX,"|",2) I FHTYPC="ZE" D HL7SET^FHOMRT1 Q ;TUBEFEEDING
37 S FHDTX=$P(FHX,"|",4),FHDIET=$P(FHDTX,U,4),FHDTX=$E(FHDTX,4,$L(FHDTX))
38 S FHCOM=$P(FHX,"|",5),FHM3=$P(FHX,"|",3)
39 I $E(FHDTX,1,4)="FH-6" D HL7SET^FHOMRA1 Q ;ADDITIONAL ORDERS
40 S FHMEAL=$S(FHM3=1:"B",FHM3=3:"N",FHM3=5:"E",1:"")
41 I FHMEAL="" S TXT="Meal missing" D GETOR^FHWOR,ERR Q
42 I FHDIET="" S TXT="Missing diet" D GETOR^FHWOR,ERR Q
43 I '$D(^FH(111,FHDIET)) S TXT="Invalid diet" D GETOR^FHWOR,ERR Q
44 I FHTYPC="S" D SM ;SPECIAL MEAL REQUEST
45 I FHTYPC="D" D RM I $G(FHAIL)'="" Q ;RECURRING MEAL ORDER
46 D SEND^FHWOR Q
47SM ; Special Meal Request
48 ; FHDFN,FHLOC set at top of FHOMWOR
49 D NOW^%DTC S FHNOW=%
50 S FHDUZ=$P($G(FHMSG(4)),"|",11),FHSTAT="P"
51 I FHDUZ'="",$D(^XUSEC("FHAUTH",FHDUZ)) S FHSTAT="A"
52 S FHQEL=1 D SETNODE^FHOMSR1
53 S FILL="S;"_FHSMID
54 Q
55RM ;
56 ; Recurring orders from CPRS will only have ONE diet, not up to 5 like
57 ; for NonVA patients/inpatients therefore can set FHDIETX1-5 = NULL
58 ; FHDFN,FHLOC set at top of FHOMWOR
59 S FHMPNUM=$O(^FHPT(FHDFN,"OP","C",""),-1) I FHMPNUM="" S FHMPNUM=0
60 S FHMPNUM=FHMPNUM+1
61 S (FHAIL,FHRMBD,FHDIETX(1),FHDIETX(2),FHDIETX(3),FHDIETX(4),FHDIETX(5))=""
62 S (C,FHENDL)=0,STDTLP=STDT,FHDZ="" F Q:FHENDL=1 D
63 .S X=STDTLP D H^%DTC S:%Y=0 %Y=7 S FHDZ=FHDZ_%Y_"^",X1=STDTLP,X2=1
64 .D C^%DTC S STDTLP=X,C=C+1 I STDTLP>ENDT!(C>6) S FHENDL=1 Q
65 S FHDAYS="" F FHH=1:1:7 S FHPCE=$P(FHDOW,"~",FHH) Q:FHPCE="" D
66 .S FHD3=$E(FHPCE,3)
67 .I FHD3'>0,FHD3'<8 Q
68 .I FHDZ'[FHD3 Q
69 .S FHDAYS=FHDAYS_$E("MTWRFSX",FHD3)
70 I FHDAYS="",$E(STDT,1,7)'=$E(ENDT,1,7) S (TXT,FHAIL)="Day of week invalid or not within date range" D GETOR^FHWOR,ERR Q
71 I FHDAYS="",$E(STDT,1,7)=$E(ENDT,1,7) S X=$E(STDT,1,7) D DOW^%DTC S FHDAYS=$E("XMTWRFS",Y+1)
72 D SETNODE^FHOMRO1
73 S FILL="R;"_FHMPNUM_";"_STDT_";"_ENDT_";"_FHDAYS_";"_FHMEAL
74 Q
75CANCEL ;Cancel outpatient orders
76 S FHENDT=ENDT,FHX=$G(FHMSG(4)),FILL=$P(FHX,"|",4),FHMPNUM=""
77 S FHORSAV=FHORN,FHILSAV=FILL,FHACTSV=ACT
78 S FHTYPE=$P(FILL,";",1) I FHTYPE="R" S FHMPNUM=$P(FILL,";",2)
79 I "AEIGSRT"'[FHTYPE S TXT="Invalid cancel code" D ERR Q
80 S X1=STDT,X2=-1 D C^%DTC S STDT1=X
81 I "AET"[FHTYPE F FHRMDT=STDT1:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>FHENDT) D
82 .F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0 D
83 ..I FHTYPE="A" D CANAO^FHOMRC1 Q
84 ..I FHTYPE="E" D CANEL^FHOMRC1 Q
85 ..I FHTYPE="T" D CANTF^FHOMRC1 Q
86 I FHTYPE="R" F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","C",FHMPNUM,FHRNUM)) Q:FHRNUM'>0 S FHRMDT=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1) D CANRM^FHOMRC1,ASSOC^FHOMRC2
87 I FHTYPE="I" D CAN^FHOMIP
88 I FHTYPE="S" S FHSMID=$P(FILL,";",2),FHCDT=FHDFN_"^"_FHSMID D CAN^FHOMSC1,CNSMEL^FHOMRC2 ;cancel a SM and associated SM Late Tray
89 I FHTYPE="G" S FHSMID=$P(FILL,";",2),FHCDT=FHDFN_"^"_FHSMID D CNSMEL^FHOMRC2 ;cancel a SM Late Tray only
90 S FHORN=FHORSAV,FILL=FHILSAV,ACT=FHACTSV D CSEND^FHWOR Q
91 Q
92NA ;Number assign for outpatient
93 S FILL=$P(FHX,"|",4)
94 S FHTYPE=$P(FILL,";",1) S (FHMPN,FHRNUM)=+$P(FILL,";",2)
95 D NA^FHOMWOR1
96 Q
97ERR ;
98 K MSG D RMSH^FHWOR ;Sets MSG(1) & MSG(2)
99 S ACT="UA" I $P(FHMSG(4),"|",2)="CA" S ACT="U"_$E($P(FHMSG(4),"|",2),1)
100 S $P(MSG(3),"|",1,2)="ORC|"_ACT,$P(MSG(3),"|",3)=FHORN
101 S $P(MSG(3),"|",4)=$P(FHMSG(3),"|",4)
102 S $P(MSG(3),"|",13)=$P(FHMSG(3),"|",13)
103 S $P(MSG(3),"|",16)=$P(FHMSG(3),"|",16),$P(MSG(3),"|",17)=TXT
104 ;
105 ;W ! F RK=0:0 S RK=$O(MSG(RK)) Q:RK'>0 W !," MSG"_RK_"= ",MSG(RK)
106 ;F RK=0:0 S RK=$O(FHMSG(RK)) Q:RK'>0 W !,"FHMSG"_RK_"= ",FHMSG(RK)
107 ;W !!,"TXT=",TXT,!!
108 ;
109 D EVSEND^FHWOR Q
110 Q
Note: See TracBrowser for help on using the repository browser.