source: FOIAVistA/trunk/r/DIETETICS-FH/FHWOR6.m@ 1166

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1FHWOR6 ; HISC/NCA - Update Orderable Items For Master File ;5/2/00 10:07
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3UPDATE ; Update Diet Orders and Tubefeedings
4 K MSG
5 I TYP="D" D CHKD
6 I TYP="T" D CHKT
7 K ACT,FILE,FILNM,K,NAM,N1,N2,PREC,STR,STR1,SYN,Z1
8 I $D(MSG) D SEND
9 Q
10CHKD ; Check which Diet Order transactions
11 S FILE="111",FILNM=$P($G(^FH(111,0)),"^",1)
12 I $P(IEN,"^",3) S CHK=1,IEN=+IEN D PROCD S CHK=0 D CHKI Q
13 S IEN=+IEN
14 I $G(^FH(111,IEN,0))="" S CHK=2 D PROCD Q
15 I NOD1'=$P($G(^FH(111,IEN,0)),"^",1,4) S CHK=3 D PROCD S CHK=0
16 S STR="" F IEN1=0:0 S IEN1=$O(^FH(111,IEN,"AN",IEN1)) Q:IEN1<1 S:STR'="" STR=STR_"," S STR=STR_IEN1
17 S STR1="" F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD3",IEN1)) Q:IEN1<1 S:STR1'="" STR1=STR1_"," S STR1=STR1_IEN1
18 I $L(STR,",")'=$L(STR1,",") S CHK=3 D PROCD S CHK=0 D CHKI Q
19 I STR'=STR1 S CHK=3 D PROCD S CHK=0 D CHKI Q
20 F K=1:1 Q:$P(STR1,",",K)="" S IEN1=$P(STR,",",K) D CHKD1
21CHKI I NOD2'="Y",$G(^FH(111,IEN,"I"))="Y" S CHK=4 D PROCD Q
22 I NOD2="Y",$G(^FH(111,IEN,"I"))'="Y" S CHK=5 D PROCD Q
23 Q
24CHKD1 I 'IEN1 S CHK=3 D PROCD S CHK=0 Q
25 I $G(^FH(111,IEN,"AN",IEN1,0))'=$G(^TMP($J,"FHNOD3",($P(STR1,",",K)))) S CHK=3 D PROCD S CHK=0
26 Q
27PROCD ; Process Diet Order Msg.
28 Q:'CHK
29 I REC D CODE^FHWORI S REC=0,N1=2
30 S Z1=$S($G(^FH(111,IEN,0))'="":$G(^FH(111,IEN,0)),1:$P(NOD1,"^",1,4))
31 G ADD:CHK=1,DLD:CHK=2,UPD:CHK=3,DCD:CHK=4,ACD:CHK=5
32 Q
33CHKT ; Check which Tubefeeding Transactions
34 S FILE="118.2",FILNM=$P($G(^FH(118.2,0)),"^",1)
35 I $P(IEN,"^",3) S CHK=1 S IEN=+IEN D PROCT S CHK=0 D CHKIN Q
36 S IEN=+IEN
37 I $G(^FH(118.2,IEN,0))="" S CHK=2 D PROCT Q
38 I NOD1'=$P($G(^FH(118.2,IEN,0)),"^",1) S CHK=3 D PROCT S CHK=0 D CHKIN Q
39 S STR="" F IEN1=0:0 S IEN1=$O(^FH(118.2,IEN,1,IEN1)) Q:IEN1<1 S:STR'="" STR=STR_"," S STR=STR_IEN1
40 S STR1="" F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD2",IEN1)) Q:IEN1<1 S:STR1'="" STR1=STR1_"," S STR1=STR1_IEN1
41 I $L(STR,",")'=$L(STR1,",") S CHK=3 D PROCT S CHK=0 D CHKIN Q
42 I STR'=STR1 S CHK=3 D PROCT S CHK=0 D CHKIN Q
43 F K=1:1 Q:$P(STR1,",",K)="" S IEN1=$P(STR,",",K) D CHKT1
44CHKIN ; Check if more than one transaction
45 I NOD3'="Y",$G(^FH(118.2,IEN,"I"))="Y" S CHK=4 D PROCT Q
46 I NOD3="Y",$G(^FH(118.2,IEN,"I"))'="Y" S CHK=5 D PROCT Q
47 Q
48CHKT1 I 'IEN1 S CHK=3 D PROCT S CHK=0 Q
49 I $G(^FH(118.2,IEN,1,IEN1,0))'=$G(^TMP($J,"FHNOD2",($P(STR1,",",K)))) S CHK=3 D PROCT S CHK=0
50 Q
51PROCT ; Process Tubefeeding Msg.
52 Q:'CHK
53 I REC D CODE^FHWORI S REC=0,N1=2
54 S Z1=$S($G(^FH(118.2,IEN,0))'="":$G(^FH(118.2,IEN,0)),1:NOD1)
55 G ADT:CHK=1,DLT:CHK=2,UPT:CHK=3,DCT:CHK=4,ACT:CHK=5
56 Q
57ADD ; Code Add Diet Order
58 S ACT="MAD" G DO
59DLD ; Code Delete Diet Order
60 S ACT="MDL" G DO
61UPD ; Code Update Diet Order
62 S ACT="MUP" G DO
63DCD ; Code Deactivate Diet Order
64 S ACT="MDC" G DO
65ACD ; Code Reactivate Deactivated Diet Order
66 S ACT="MAC" G DO
67ADT ; Code Add Tubefeeding
68 S ACT="MAD" G TF
69DLT ; Code Delete Tubefeeding
70 S ACT="MDL" G TF
71UPT ; Code Update Tubefeeding
72 S ACT="MUP" G TF
73DCT ; Code Deactive Tubefeeding
74 S ACT="MDC" G TF
75ACT ; Code Reactivate Deactivated Tubefeeding
76 S ACT="MAC" G TF
77DO ; Code Diet Order MFE, ZFH, and ZSY
78 S NAM=$P(Z1,"^",1) Q:NAM="" S PREC=$P(Z1,"^",4) Q:'PREC
79 S SYN=$P(Z1,"^",2),N1=N1+1
80 S MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHD"
81 S N1=N1+1,MSG(N1)="ZFH|D|"_PREC_"||"_$P(Z1,"^",3)
82 I $G(^FH(111,IEN,0))="" S FHK=0 D Q
83 .F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD3",IEN1)) Q:IEN1<1 S FHK=IEN1 D
84 ..S SYN1=$G(^TMP($J,"FHNOD3",IEN1)) I SYN1'="" S N1=N1+1,MSG(N1)="ZSY|"_IEN1_"|"_SYN1 Q
85 .I SYN'="" S N1=N1+1,MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
86 .Q
87 S FHK=0 F IEN1=0:0 S IEN1=$O(^FH(111,IEN,"AN",IEN1)) Q:IEN1<1 S SYN1=$G(^(IEN1,0)) D
88 .S FHK=IEN1,SYN1=$P(SYN1,"^",1) I SYN1'="" S N1=N1+1,MSG(N1)="ZSY|"_IEN1_"|"_SYN1 Q
89 I SYN'="" S N1=N1+1,MSG(N1)="ZSY|"_(FHK+1)_"|"_SYN
90 Q
91TF ; Code Tubefeeding MFE, ZFH, and ZSY
92 S NAM=$P(Z1,"^",1) Q:NAM="" S N1=N1+1
93 S MSG(N1)="MFE|"_ACT_"|||^^^"_IEN_"^"_NAM_"^99FHT"
94 S N1=N1+1,MSG(N1)="ZFH|T|"
95 I $G(^FH(118.2,IEN,0))="" D Q
96 .F IEN1=0:0 S IEN1=$O(^TMP($J,"FHNOD2",IEN1)) Q:IEN1<1 D
97 ..S SYN=$G(^TMP($J,"FHNOD2",IEN1)) I SYN'="" D
98 ..S N1=N1+1
99 ..S MSG(N1)="ZSY|"_IEN1_"|"_SYN Q
100 .Q
101 F IEN1=0:0 S IEN1=$O(^FH(118.2,IEN,1,IEN1)) Q:IEN1<1 S SYN=$G(^(IEN1,0)) D
102 .S SYN=$P(SYN,"^",1) Q:SYN="" S N1=N1+1
103 .S MSG(N1)="ZSY|"_IEN1_"|"_SYN Q
104 Q
105SEND ; Send Message to OE/RR
106 D MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)
107 K MSG Q
Note: See TracBrowser for help on using the repository browser.