Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSFH

GMTSFH.m

Go to the documentation of this file.
  1. GMTSFH ; SLC/JER,MKB,KER - Dietetics Component ; 02/27/2002
  1. ;;2.7;Health Summary;**25,28,49,83**;Oct 20, 1995;Build 1
  1. ;
  1. ; External References
  1. ; DBIA 1407 ^FHWHEA
  1. ;
  1. MAIN ; Controls branching and execution
  1. N GMI,MAX S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
  1. D ^FHWHEA Q:'$D(^UTILITY($J)) F GMI="DI","NS","SF","TF","EN" D @GMI
  1. K ^UTILITY($J),STR,COL,TX,STRT,STP,CNTR
  1. Q
  1. DI ; Diet Orders
  1. S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W "DIETS:",!
  1. I '$D(^UTILITY($J,"DI")) D CKP^GMTSUP Q:$D(GMTSQIT) W "No diet orders available.",! Q
  1. N GMW,GMIDT S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"DI",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D DIWRT
  1. Q
  1. DIWRT ; Writes Diet Orders
  1. S CNTR=CNTR-1 I CNTR<0 Q
  1. N GMZ S GMZ=^UTILITY($J,"DI",GMIDT,0)
  1. S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
  1. I $P(GMZ,U,2)="" S STP="Present"
  1. E S X=+$P(GMZ,U,2) D REGDT4^GMTSU S STP=X
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,?25
  1. S STR=$S($P(GMZ,U,3)'="":$P(GMZ,U,3),1:"No diet orders on file.")
  1. I $L(STR)<40 W STR
  1. E S COL=27 D WRAP
  1. W:$P(GMZ,U,5)'="" ?61,"("_$P(GMZ,U,5)_")" W !
  1. I $P(GMZ,U,4)'="" D DICOM
  1. Q
  1. DICOM ; Writes comments for DI
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W " Comments: "
  1. I $L($P(GMZ,U,4))<55 W $P(GMZ,U,4),!
  1. E S STR=$P(GMZ,U,4),COL=45 D WRAP W !
  1. Q
  1. NS ; Nutritional status
  1. I '$D(^UTILITY($J,"NS")) Q
  1. S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,"NUTRITIONAL STATUS:",!
  1. N GMW,GMIDT
  1. S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"NS",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D NSWRT
  1. Q
  1. NSWRT ; Writes Nutritional Status
  1. S CNTR=CNTR-1 I CNTR<0 Q
  1. N GMZ S GMZ=^UTILITY($J,"NS",GMIDT,0)
  1. S X=+$P(GMZ,U) D REGDTM4^GMTSU S STRT=X
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W STRT,?21,$S($P(GMZ,U,2)'="":$P(GMZ,U,2),1:"No status on file."),!
  1. Q
  1. SF ; Supplemental feeding
  1. I '$D(^UTILITY($J,"SF")) Q
  1. S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,"SUPPLEMENTAL FEEDINGS:",!
  1. N GMW,GMIDT
  1. S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"SF",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D SFWRT
  1. Q
  1. SFWRT ; Writes Supplemental Feedings
  1. S CNTR=CNTR-1 I CNTR<0 Q
  1. N GMZ S GMZ=^UTILITY($J,"SF",GMIDT,0)
  1. S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
  1. I $P(GMZ,U,2)="" S STP="Present"
  1. E S X=+$P(GMZ,U,2) D REGDT4^GMTSU S STP=X
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,!
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?14,"10 Am " S STR=$S($P(GMZ,U,3)'="":$P(GMZ,U,3),1:"No order")
  1. I $L(STR)<55 W STR,!
  1. E S COL=45 D WRAP W !
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?14," 2 Pm " S STR=$S($P(GMZ,U,4)'="":$P(GMZ,U,4),1:"No order")
  1. I $L(STR)<55 W STR,!
  1. E S COL=45 D WRAP W !
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?14," 8 Pm " S STR=$S($P(GMZ,U,5)'="":$P(GMZ,U,5),1:"No order")
  1. I $L(STR)<55 W STR,!
  1. E S COL=45 D WRAP W !
  1. Q
  1. TF ; Tubefeeding
  1. I '$D(^UTILITY($J,"TF")) Q
  1. S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,"TUBE FEEDINGS:",!
  1. N GMW,GMIDT
  1. S GMIDT=GMTS1 F S GMIDT=$O(^UTILITY($J,"TF",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D TFWRT
  1. Q
  1. TFWRT ; Writes tubefeeding
  1. S CNTR=CNTR-1 I CNTR<0 Q
  1. N GMZ S GMZ=^UTILITY($J,"TF",GMIDT,0)
  1. S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
  1. I $P(GMZ,U,2)="" S STP="Present"
  1. E S X=+$P(GMZ,U,2) D REGDT4^GMTSU S STP=X
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W STRT_" - "_STP,!
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,"Product: ",$P(GMZ,U,3),!
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?11,"Strength: ",$P(GMZ,U,4),?51,"Quantity: ",$P(GMZ,U,5),!
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Daily CC's: ",$P(GMZ,U,6),?47,"Daily KCal's: ",$P(GMZ,U,7),!
  1. I $P(GMZ,U,8)'="" D TFCOM
  1. Q
  1. TFCOM ; Writes comments for TF
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?11,"Comments: "
  1. I $L($P(GMZ,U,8))<55 W $P(GMZ,U,8),!
  1. E S STR=$P(GMZ,U,8),COL=45 D WRAP W !
  1. Q
  1. WRAP ; Controls wrap-around feature for comments, etc.
  1. S TX=$F(STR," ",COL) W $E(STR,1,TX-1),!
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$E(STR,TX,$L(STR))
  1. Q
  1. EN ; Dietetic Encounters
  1. S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999) Q:'$D(^UTILITY($J,"EN"))
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,"DIETETIC ENCOUNTERS:",! N GMW,GMIDT S GMIDT=GMTS1
  1. F S GMIDT=$O(^UTILITY($J,"EN",GMIDT)) Q:(GMIDT'>0)!(GMIDT>GMTS2) D
  1. . S CNTR=CNTR-1 I CNTR<0 Q
  1. . N GMZ S GMZ=^UTILITY($J,"EN",GMIDT,0)
  1. . S X=+$P(GMZ,U) D REGDT4^GMTSU S STRT=X
  1. . D CKP^GMTSUP Q:$D(GMTSQIT) W STRT,?12,$P(GMZ,U,2),!
  1. . I $P(GMZ,U,3)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,$P(GMZ,U,3),!
  1. . I $P(GMZ,U,4)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,$P(GMZ,U,4),!
  1. . I $D(^UTILITY($J,"NA",GMIDT)) D
  1. . . ;I $G(^UTILITY($J,"NA",GMIDT,1)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,$G(^UTILITY($J,"NA",GMIDT,1)),!
  1. . . ;I $G(^UTILITY($J,"NA",GMIDT,3)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,"Comments:",!
  1. . . 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)),!
  1. Q