source: FOIAVistA/trunk/r/DIETETICS-FH/FH55P5.m@ 711

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1FH55P5 ;ALB/TDP - POST-INIT FOR PATCH FH*5.5*5 ;12/13/2005
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3 Q
4POST ;
5 D BMES^XPDUTL("Searching for DIETS (#111) file entries which are out of sync with the")
6 D MES^XPDUTL(" corresponding entry in the ORDERABLE ITEM (#101.43) file...")
7 D DIET
8 D BMES^XPDUTL("Searching for TUBEFEEDING (#118.2) file entries which are out of sync with")
9 D MES^XPDUTL(" the corresponding entry in the ORDERABLE ITEM (#101.43) file...")
10 D TF
11 D BMES^XPDUTL("Searching for DIET PATTERN (#111.1) names which are out of sync with")
12 D MES^XPDUTL(" corresponding DIET ABBREVIATED LABELS...")
13 D UPDPAT
14 D BMES^XPDUTL("Post-init complete.")
15 Q
16 ;
17DIET ;
18 N DIFF,FH0,FHACT,FHFILE,FHFLNM,FHIEN,FHIEN1,FHINACT
19 N FHNM,FHORIEN,FHSYN,FHTYP
20 K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")
21 S FHTYP="D"
22 S FHFILE="111",FHFLNM=$P($G(^FH(111,0)),"^",1)
23 S FHNM=""
24 F S FHNM=$O(^FH(111,"B",FHNM)) Q:FHNM="" D
25 . S FHIEN=""
26 . F S FHIEN=$O(^FH(111,"B",FHNM,FHIEN)) Q:FHIEN="" D
27 .. S DIFF=0
28 .. S FHINACT=$G(^FH(111,+FHIEN,"I")) I FHINACT="N" S FHINACT=""
29 .. S FH0=$G(^FH(111,+FHIEN,0))
30 .. S FHNM=$P(FH0,U,1) I FHNM="" Q
31 .. S ^TMP($J,"FH55P5_nutrition",FHNM)=FHINACT
32 .. F FHIEN1=0:0 S FHIEN1=$O(^FH(111,+FHIEN,"AN",FHIEN1)) Q:FHIEN1<1 D
33 ... S FHSYN=$G(^FH(111,+FHIEN,"AN",FHIEN1,0))
34 ... S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""
35 .. S FHSYN=$P(FH0,U,2)
36 .. I FHSYN'="" S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""
37 .. D ORDER
38 .. D COMPARE
39 .. I DIFF D UPDATE
40 .. K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")
41 Q
42TF ;
43 N DIFF,FH0,FHACT,FHFILE,FHFLNM,FHIEN,FHIEN1,FHINACT
44 N FHNM,FHORIEN,FHSYN,FHTYP
45 K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")
46 S FHTYP="T"
47 S FHFILE="118.2",FHFLNM=$P($G(^FH(118.2,0)),"^",1)
48 S FHNM=""
49 F S FHNM=$O(^FH(118.2,"B",FHNM)) Q:FHNM="" D
50 . S FHIEN=""
51 . F S FHIEN=$O(^FH(118.2,"B",FHNM,FHIEN)) Q:FHIEN="" D
52 .. S DIFF=0
53 .. S FHINACT=$G(^FH(118.2,+FHIEN,"I")) I FHINACT="N" S FHINACT=""
54 .. S FH0=$G(^FH(118.2,+FHIEN,0))
55 .. S FHNM=$P(FH0,U,1) I FHNM="" Q
56 .. S ^TMP($J,"FH55P5_nutrition",FHNM)=FHINACT
57 .. F FHIEN1=0:0 S FHIEN1=$O(^FH(118.2,+FHIEN,1,FHIEN1)) Q:FHIEN1<1 D
58 ... S FHSYN=$G(^FH(118.2,+FHIEN,1,FHIEN1,0))
59 ... S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""
60 .. ;S FHSYN=$P(FH0,U,2)
61 .. ;I FHSYN'="" S:'$D(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)) ^TMP($J,"FH55P5_nutrition",FHNM,FHSYN)=""
62 .. D ORDER
63 .. D COMPARE
64 .. I DIFF D UPDATE
65 .. K ^TMP($J,"FH55P5_nutrition"),^TMP($J,"FH55P5_order")
66 Q
67ORDER ;COMPILE ORD(101.43 DATA RELATED TO DIET ORDER/TF PRODUCT
68 N FHORIN,FHORNM,FHORSYN
69 S FHORIEN=$O(^ORD(101.43,"ID",+FHIEN_";99FH"_FHTYP,0))
70 I +FHORIEN<1 Q
71 S FHORIN=$G(^ORD(101.43,FHORIEN,.1))
72 I FHORIN'="" S FHORIN="Y"
73 S FHORNM=$P($G(^ORD(101.43,FHORIEN,0)),U,1) I FHORNM="" S FHORNM="UNKNOWN NAME (FH55P5)"
74 S ^TMP($J,"FH55P5_order",FHORNM)=FHORIN
75 S FHORSYN=""
76 F S FHORSYN=$O(^ORD(101.43,FHORIEN,2,"B",FHORSYN)) Q:FHORSYN="" D
77 . S:'$D(^TMP($J,"FH55P5_order",FHORNM,FHORSYN)) ^TMP($J,"FH55P5_order",FHORNM,FHORSYN)=""
78 Q
79COMPARE ;COMPARE ORD(101.43 ENTRY TO FH(111 OR FH(118.2 ENTRY
80 N FHINACT,FHNM,FHORIN,FHORNM,FHORSYN,FHSYN
81 I '$D(^TMP($J,"FH55P5_order")) Q
82 S (FHACT,FHNM,FHORNM,FHORSYN,FHSYN)=""
83 S FHNM=$O(^TMP($J,"FH55P5_nutrition",FHNM))
84 S FHORNM=$O(^TMP($J,"FH55P5_order",FHORNM))
85 I FHNM'=FHORNM S DIFF=1
86 S FHINACT=$G(^TMP($J,"FH55P5_nutrition",FHNM))
87 S FHORIN=$G(^TMP($J,"FH55P5_order",FHORNM))
88 I FHINACT'=FHORIN S DIFF=1 D
89 . I FHINACT="Y" S FHACT=$$FMTHL7^XLFDT($$NOW^XLFDT)
90 . I FHINACT'="Y" S FHACT=""
91 I FHINACT=FHORIN,FHINACT="Y" D
92 . S FHACT=$O(^ORD(101.43,"ID",FHIEN_";99FH"_FHTYP,0))
93 . S FHACT=$G(^ORD(101.43,FHACT,.1))
94 . S FHACT=$$FMTHL7^XLFDT(FHACT)
95CLOOP S FHSYN=$O(^TMP($J,"FH55P5_nutrition",FHNM,FHSYN))
96 S FHORSYN=$O(^TMP($J,"FH55P5_order",FHORNM,FHORSYN))
97 I FHSYN'="",FHSYN=FHORSYN G CLOOP
98 I FHSYN'=FHORSYN S DIFF=1
99 Q
100UPDATE ;FORMAT AND SEND UPDATE MESSAGE
101 N CNT,FHNAM,MSG
102 S CNT=1
103 S MSG(CNT)="MSH|^~\&|DIETETICS|"_^DD("SITE",1)_"|||||MFN"
104 ; code MFI
105 S CNT=CNT+1
106 S MSG(CNT)="MFI|"_FHFILE_"^"_FHFLNM_"^99DD||UPD|||NE"
107 S FHNAM=""
108 F S FHNAM=$O(^TMP($J,"FH55P5_nutrition",FHNAM)) Q:FHNAM="" D
109 . S CNT=CNT+1
110 . S MSG(CNT)="MFE|MUP||"_FHACT_"|^^^"_FHIEN_"^"_FHNAM_"^99FH"_FHTYP
111 . S CNT=CNT+1
112 . I FHTYP="D" S MSG(CNT)="ZFH|D|"_$P(FH0,U,4)_"||"_$P(FH0,U,3)
113 . I FHTYP="T" S MSG(CNT)="ZFH|T|"
114 . S FHSYN=""
115 . F S FHSYN=$O(^TMP($J,"FH55P5_nutrition",FHNAM,FHSYN)) Q:FHSYN="" D
116 .. S CNT=CNT+1,MSG(CNT)="ZSY|"_CNT_"|"_FHSYN
117 I $D(MSG) D SEND
118 Q
119SEND ; Send Message to OE/RR
120 D MSG^XQOR("FH ORDERABLE ITEM UPDATE",.MSG)
121 D BMES^XPDUTL(" Updated ORDERABLE ITEM (#101.43) file entry #"_FHORIEN_" with data")
122 D MES^XPDUTL(" for "_FHNM_" from the "_$S($G(FHTYP)="D":"DIETS (#111) file",1:"TUBEFEEDING (#118.2) file"))
123 K MSG
124 Q
125UPDPAT ; Update Diet Pattern names
126 S FLG=0 F FHDPIEN=0:0 S FHDPIEN=$O(^FH(111.1,FHDPIEN)) Q:FHDPIEN'>0 D
127 .S FHFND=0,FHOLDNM=$P($G(^FH(111.1,FHDPIEN,0)),U,1),FHNEWNM=""
128 .S FHDPDTS=$P($G(^FH(111.1,FHDPIEN,0)),U,2,6)
129 .F FHPCE=1:1:5 D
130 ..S FHDTPTR=$P(FHDPDTS,U,FHPCE) Q:FHDTPTR=""
131 ..S FHNEWNM=FHNEWNM_$S(FHNEWNM="":"",1:", ")
132 ..S FHNEWNM=FHNEWNM_$P($G(^FH(111,FHDTPTR,0)),U,7)
133 .I FHOLDNM=FHNEWNM Q
134 .S FLG=1 D BMES^XPDUTL(" Updated "_FHOLDNM_" to "_FHNEWNM)
135 .K DIE S DIE="^FH(111.1,",DA=FHDPIEN,DR=".01////^S X=FHNEWNM" D ^DIE
136 Q
Note: See TracBrowser for help on using the repository browser.