source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXNUT1.m@ 1474

ECXNUT1 ;ALB/JRC Nutrition DSS Extract ; 10/27/06 1:53pm
 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
 Q
 ;
GETMEALS ;get patient meals 
 ;init variables
 N DATE,FHDFN,ECXADM,NODE,PRODUCT,ECXQTY,ORDER,ECXORDPH,ECXKEY,P,D
 N ECXFPD,ECXFDD,ECXFPF,ECXDLT,ECXDFL,NUMBER,PNODE,SF,TF,TFNODE
 ;S (DATE,FHDFN,NUMBER,ECXQTY)=0,(ECXADM,NODE,ORDER,ECXORDPH)=""
 ;Get inpatient diets
 ;S P="INP",D="PD" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 ;. F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D
 ;.. F  S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM  D
 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"INP")) Q:'NODE
 ;... S PRODUCT=$P(NODE,U,13),ECXQTY=1,ORDER=""_$P(NODE,U,14)_","_""
 ;... S ECXORDPH=$$GET1^DIQ(100,+ORDER,1,"I")
 ;... ;Resolve feeder key for nutrition product
 ;... S ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT)
 ;... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 ;... ;Get additional data and file record.
 ;... D GET^ECXNUT
 ;Get inpatient supplemental feedings
 ;S (FHDFN,DATE)=0,(ECXADM,NODE,ORDER,ECXORDPH)=""
 ;S P="INP",D="SF" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 ;. F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN  D
 ;.. F  S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM  D
 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"SF")) Q:'NODE
 ;... F SF=5:2:27 S PRODUCT=$P(NODE,U,SF) Q:PRODUCT']""  S ECXQTY=1 D
 ;.... S ORDER=""_$P(NODE,U,7)_","_""
 ;.... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")
 ;.... ;Resolve external value for product key
 ;.... S ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT)
 ;.... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 ;.... ;Get additional data and file record.
 ;.... D GET^ECXNUT
 ;Get inpatient standing orders
 ;S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""
 ;S P="INP",D="SO" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 ;. F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN  D
 ;.. F  S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM  D
 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"SO")) Q:'NODE
 ;... S PRODUCT=$P(NODE,U,2),ECXQTY=1
 ;... ;Resolve external value for product key
 ;... S ECXKEY=$$NUTKEY^ECXUTL6("SO",PRODUCT)
 ;... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 ;... ;Get additional data and file record.
 ;... D GET^ECXNUT
 ;Get inpatient tube feedings
 ;S (FHDFN,DATE,P)=0,(ECXADM,NODE,ECXORDPH,PNODE)=""
 ;S P="INP",D="TF" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 ;. F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D
 ;.. F  S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM  D
 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF")) Q:'NODE
 ;... S P=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF",P)) Q:'P  D
 ;.... S PNODE=^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF",P,"P")
 ;.... S PRODUCT=$P(PNODE,U,1),ECXQTY=$P(PNODE,U,4)
 ;.... S ORDER=""_$P(NODE,U,14)_","_""
 ;.... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")
 ;.... ;Resolve external value for product key
 ;.... S ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT)
 ;.... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 ;.... ;Get additional data and file record.
 ;.... D GET^ECXNUT
 ;Get outpatient recurring meals
 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""
 S P="OP",D="RM" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 . F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D
 .. S NUMBER=0 F  S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER  D
 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM")) Q:'NODE
 ... S PRODUCT=$P(NODE,U,2),ECXQTY=1,ORDER=""_$P(NODE,U,12)_","_""
 ... S PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I")
 ... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")
 ... ;Resolve external value for product key
 ... S ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT)
 ... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 ... ;Get additional data and file record.
 ... D GET^ECXNUT
 ;Get outpatient tube feedings
 S (FHDFN,DATE,NUMBER)=0,(ECXADM,NODE,ECXORDPH)=""
 S P="OP",D="TF" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 . F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN))  Q:'FHDFN  D
 .. F  S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER  D
 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF")) Q:'NODE
 ... S TF=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)) Q:'TF  D
 .... S TFNODE=^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)
 .... S PRODUCT=$P(TFNODE,U,1),ECXQTY=$P(TFNODE,U,4)
 .... ;Resolve external value for product key
 .... S ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT)
 .... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 .... ;Get additional data and file record.
 .... D GET^ECXNUT
 ;Get outpatient special meals
 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""
 S P="OP",D="SM" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 . F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN  D
 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"SM")) Q:'NODE
 .. S PRODUCT=$P(NODE,U,13),ECXQTY=1,ECXORDPH=$P(NODE,U,5)
 .. ;Resolve external value for product key
 .. S ECXKEY=$$NUTKEY^ECXUTL6("SM",PRODUCT)
 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 .. ;Get additional data and file record.
 .. D GET^ECXNUT
 ;Get outpatient guest meals
 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""
 S P="OP",D="GM" F  S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE  D
 . F  S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN  D
 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"GM")) Q:'NODE
 .. S PRODUCT=$P(NODE,U,13),ECXQTY=1
 .. ;Resolve external value for product key
 .. S ECXKEY=$$NUTKEY^ECXUTL6("GM",PRODUCT)
 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
 .. ;Get additional data and file record.
 .. D GET^ECXNUT
 Q