source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSFH1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1GMTSFH1 ; SLC/JER,MKB - Dietetics Component con't ;1/29/91 11:44
2 ;;2.5;Health Summary;;Dec 16, 1992
3SF ; Supplemental feeding
4 I '$D(^UTILITY($J,"SF")) Q
5 S CNTR=GMTSNDM
6 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"SUPPLEMENTAL FEEDINGS:",!
7 N GMW,GMIDT
8 S GMIDT=GMTS1 F GMW=0:0 S GMIDT=$O(^UTILITY($J,"SF",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D SFWRT
9 Q
10SFWRT ; Writes Supplemental Feedings
11 S CNTR=CNTR-1 I CNTR<0 Q
12 N GMZ S GMZ=^UTILITY($J,"SF",GMIDT,0)
13 S X=+$P(GMZ,U) D REGDT^GMTSU S STRT=X
14 I $P(GMZ,U,2)="" S STP="Present"
15 E S X=+$P(GMZ,U,2) D REGDT^GMTSU S STP=X
16 D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,!
17 D CKP^GMTSUP Q:$D(GMTSQIT) W ?14,"10 Am " S STR=$S($P(GMZ,U,3)'="":$P(GMZ,U,3),1:"No order")
18 I $L(STR)<55 W STR,!
19 E S COL=45 D WRAP W !
20 D CKP^GMTSUP Q:$D(GMTSQIT) W ?14," 2 Pm " S STR=$S($P(GMZ,U,4)'="":$P(GMZ,U,4),1:"No order")
21 I $L(STR)<55 W STR,!
22 E S COL=45 D WRAP W !
23 D CKP^GMTSUP Q:$D(GMTSQIT) W ?14," 8 Pm " S STR=$S($P(GMZ,U,5)'="":$P(GMZ,U,5),1:"No order")
24 I $L(STR)<55 W STR,!
25 E S COL=45 D WRAP W !
26 Q
27TF ; Tubefeeding
28 I '$D(^UTILITY($J,"TF")) Q
29 S CNTR=GMTSNDM
30 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"TUBE FEEDINGS:",!
31 N GMW,GMIDT
32 S GMIDT=GMTS1 F GMW=0:0 S GMIDT=$O(^UTILITY($J,"TF",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D TFWRT
33 Q
34TFWRT ; Writes tubefeeding
35 S CNTR=CNTR-1 I CNTR<0 Q
36 N GMZ S GMZ=^UTILITY($J,"TF",GMIDT,0)
37 S X=+$P(GMZ,U) D REGDT^GMTSU S STRT=X
38 I $P(GMZ,U,2)="" S STP="Present"
39 E S X=+$P(GMZ,U,2) D REGDT^GMTSU S STP=X
40 D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,!
41 D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,"Product: ",$P(GMZ,U,3),!
42 D CKP^GMTSUP Q:$D(GMTSQIT) W ?11,"Strength: ",$P(GMZ,U,4),?51,"Quantity: ",$P(GMZ,U,5),!
43 D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Daily CC's: ",$P(GMZ,U,6),?47,"Daily KCal's: ",$P(GMZ,U,7),!
44 I $P(GMZ,U,8)'="" D TFCOM
45 Q
46TFCOM ; Writes comments for TF
47 D CKP^GMTSUP Q:$D(GMTSQIT) W ?11,"Comments: "
48 I $L($P(GMZ,U,8))<55 W $P(GMZ,U,8),!
49 E S STR=$P(GMZ,U,8),COL=45 D WRAP W !
50 Q
51WRAP ; Controls wrap-around feature for comments, etc.
52 S TX=$F(STR," ",COL) W $E(STR,1,TX-1),!
53 D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$E(STR,TX,$L(STR))
54 Q
Note: See TracBrowser for help on using the repository browser.