source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSFH.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.7 KB
Line 
1GMTSFH ; SLC/JER,MKB,KER - Dietetics Component ; 02/27/2002
2 ;;2.7;Health Summary;**25,28,49,83**;Oct 20, 1995;Build 1
3 ;
4 ; External References
5 ; DBIA 1407 ^FHWHEA
6 ;
7MAIN ; Controls branching and execution
8 N GMI,MAX S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
9 D ^FHWHEA Q:'$D(^UTILITY($J)) F GMI="DI","NS","SF","TF","EN" D @GMI
10 K ^UTILITY($J),STR,COL,TX,STRT,STP,CNTR
11 Q
12DI ; Diet Orders
13 S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
14 D CKP^GMTSUP Q:$D(GMTSQIT) W "DIETS:",!
15 I '$D(^UTILITY($J,"DI")) D CKP^GMTSUP Q:$D(GMTSQIT) W "No diet orders available.",! Q
16 N GMW,GMIDT S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"DI",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D DIWRT
17 Q
18DIWRT ; Writes Diet Orders
19 S CNTR=CNTR-1 I CNTR<0 Q
20 N GMZ S GMZ=^UTILITY($J,"DI",GMIDT,0)
21 S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
22 I $P(GMZ,U,2)="" S STP="Present"
23 E S X=+$P(GMZ,U,2) D REGDT4^GMTSU S STP=X
24 D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,?25
25 S STR=$S($P(GMZ,U,3)'="":$P(GMZ,U,3),1:"No diet orders on file.")
26 I $L(STR)<40 W STR
27 E S COL=27 D WRAP
28 W:$P(GMZ,U,5)'="" ?61,"("_$P(GMZ,U,5)_")" W !
29 I $P(GMZ,U,4)'="" D DICOM
30 Q
31DICOM ; Writes comments for DI
32 D CKP^GMTSUP Q:$D(GMTSQIT) W " Comments: "
33 I $L($P(GMZ,U,4))<55 W $P(GMZ,U,4),!
34 E S STR=$P(GMZ,U,4),COL=45 D WRAP W !
35 Q
36NS ; Nutritional status
37 I '$D(^UTILITY($J,"NS")) Q
38 S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
39 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"NUTRITIONAL STATUS:",!
40 N GMW,GMIDT
41 S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"NS",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D NSWRT
42 Q
43NSWRT ; Writes Nutritional Status
44 S CNTR=CNTR-1 I CNTR<0 Q
45 N GMZ S GMZ=^UTILITY($J,"NS",GMIDT,0)
46 S X=+$P(GMZ,U) D REGDTM4^GMTSU S STRT=X
47 D CKP^GMTSUP Q:$D(GMTSQIT)
48 W STRT,?21,$S($P(GMZ,U,2)'="":$P(GMZ,U,2),1:"No status on file."),!
49 Q
50SF ; Supplemental feeding
51 I '$D(^UTILITY($J,"SF")) Q
52 S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
53 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"SUPPLEMENTAL FEEDINGS:",!
54 N GMW,GMIDT
55 S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"SF",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D SFWRT
56 Q
57SFWRT ; Writes Supplemental Feedings
58 S CNTR=CNTR-1 I CNTR<0 Q
59 N GMZ S GMZ=^UTILITY($J,"SF",GMIDT,0)
60 S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
61 I $P(GMZ,U,2)="" S STP="Present"
62 E S X=+$P(GMZ,U,2) D REGDT4^GMTSU S STP=X
63 D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,!
64 D CKP^GMTSUP Q:$D(GMTSQIT) W ?14,"10 Am " S STR=$S($P(GMZ,U,3)'="":$P(GMZ,U,3),1:"No order")
65 I $L(STR)<55 W STR,!
66 E S COL=45 D WRAP W !
67 D CKP^GMTSUP Q:$D(GMTSQIT) W ?14," 2 Pm " S STR=$S($P(GMZ,U,4)'="":$P(GMZ,U,4),1:"No order")
68 I $L(STR)<55 W STR,!
69 E S COL=45 D WRAP W !
70 D CKP^GMTSUP Q:$D(GMTSQIT) W ?14," 8 Pm " S STR=$S($P(GMZ,U,5)'="":$P(GMZ,U,5),1:"No order")
71 I $L(STR)<55 W STR,!
72 E S COL=45 D WRAP W !
73 Q
74TF ; Tubefeeding
75 I '$D(^UTILITY($J,"TF")) Q
76 S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
77 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"TUBE FEEDINGS:",!
78 N GMW,GMIDT
79 S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"TF",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D TFWRT
80 Q
81TFWRT ; Writes tubefeeding
82 S CNTR=CNTR-1 I CNTR<0 Q
83 N GMZ S GMZ=^UTILITY($J,"TF",GMIDT,0)
84 S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
85 I $P(GMZ,U,2)="" S STP="Present"
86 E S X=+$P(GMZ,U,2) D REGDT4^GMTSU S STP=X
87 D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,!
88 D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,"Product: ",$P(GMZ,U,3),!
89 D CKP^GMTSUP Q:$D(GMTSQIT) W ?11,"Strength: ",$P(GMZ,U,4),?51,"Quantity: ",$P(GMZ,U,5),!
90 D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Daily CC's: ",$P(GMZ,U,6),?47,"Daily KCal's: ",$P(GMZ,U,7),!
91 I $P(GMZ,U,8)'="" D TFCOM
92 Q
93TFCOM ; Writes comments for TF
94 D CKP^GMTSUP Q:$D(GMTSQIT) W ?11,"Comments: "
95 I $L($P(GMZ,U,8))<55 W $P(GMZ,U,8),!
96 E S STR=$P(GMZ,U,8),COL=45 D WRAP W !
97 Q
98WRAP ; Controls wrap-around feature for comments, etc.
99 S TX=$F(STR," ",COL) W $E(STR,1,TX-1),!
100 D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$E(STR,TX,$L(STR))
101 Q
102EN ; Dietetic Encounters
103 S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999) Q:'$D(^UTILITY($J,"EN"))
104 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"DIETETIC ENCOUNTERS:",! N GMW,GMIDT S GMIDT=GMTS1
105 F S GMIDT=$O(^UTILITY($J,"EN",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D
106 . S CNTR=CNTR-1 I CNTR<0 Q
107 . N GMZ S GMZ=^UTILITY($J,"EN",GMIDT,0)
108 . S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
109 . D CKP^GMTSUP Q:$D(GMTSQIT) W STRT,?12,$P(GMZ,U,2),!
110 . I $P(GMZ,U,3)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,$P(GMZ,U,3),!
111 . I $P(GMZ,U,4)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,$P(GMZ,U,4),!
112 . I $D(^UTILITY($J,"NA",GMIDT)) D
113 . . ;I $G(^UTILITY($J,"NA",GMIDT,1)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,$G(^UTILITY($J,"NA",GMIDT,1)),!
114 . . ;I $G(^UTILITY($J,"NA",GMIDT,3)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,"Comments:",!
115 . . N I S I=0 F S I=$O(^UTILITY($J,"NA",GMIDT,I)) Q:'I D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,$G(^UTILITY($J,"NA",GMIDT,I)),!
116 Q
Note: See TracBrowser for help on using the repository browser.