source: FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL6.m@ 636

ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ; 11/2/06 8:30am
 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
 ;
NUTKEY(P,D) ;Generate n&fs feeder key
 ;Required variables
 ;      p  - diet type production diet, standing orders, supplemental
 ;           feedings, or tube feedings.
 ;      d  - diet ien from files 116.2, 116.3, 118, or 118.2
 ;Check input
 I $G(P)=""!'$G(D) Q ""
 ;Init variables
 N PRO,IENS,CODE,DIET
 S (PRO,IENS,CODE,DIET)=0
 S PRO=$O(^ECX(728.45,"B",P,PRO))
 S CODE=D_$S(P="PD":";FH(116.2,",P="SO":";FH(116.3,",P="SF":";FH(118,",P="TF":";FH(118.2,",1:"")
 S DIET=0,DIET=$O(^ECX(728.45,+PRO,1,"B",CODE,DIET))
 S IENS=""_DIET_","_PRO_","_""
 Q $$GET1^DIQ(728.451,IENS,1)
 ;
NUTLOC(P,D,FPD,FDD,FPF,DLT,DFL) ;Define nutrition fields
 ;Required variables
 ;      p  - patient status, inpatient or outpatient
 ;
 ;      d  - diet type production diet, standing orders, supplemental
 ;            feedings, or tube feedings.
 ;    Output: food production division, food delivery division, food
 ;            production facility, food delivery type, delivery feeder
 ;            location
 ;Init variables
 N WARD,TRSVP,OPLOC,MASWARD
 S TRSVP=0,(WARD,ECXDLT,ECXDFL,MASWARD)=""
 S OPLOC=""
 ;Check input
 I $G(P)=""!($G(D)="")!'($G(FHDFN)) Q ""
 ;Get food production facility for inpatient, use 115.1.13 (dietetic
 ;ward) field which points 119.6 (nutrition location), field 3 (tray
 ;service point) or field 4 (cafeteria service point), which points to
 ;119.72 (production facility) field 2.
 I P="INP" D
 .S WARD=$P($G(^FHPT(FHDFN,"A",ECXADM,0)),U,8)
 .S TRSVP=$$GET1^DIQ(119.6,WARD,3,"I")
 .;Get divisions
 .D GETDIV
 .Q
 ;
 ;Get food production facility for outpatient recurring meal, use
 ;115.16.2 (outpatient location) which points to file 119.6 (nutrition
 ;location) field 3 (tray service point) or field 4 (cafeteria service
 ;point), which points to 119.72 (production facility) field 2.
 I P["OP",D["RM" D
 .S OPLOC=""_$P(NODE,U,3)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
 .D GETDIV
 .Q
 ;
 ;Get food production facility for outpatient tube feeding, use
 ;115.16.2 (outpatient location) then use 119.6 nutrition location
 ;which points to 119.72 field 2.
 I P["OP",D["TF" D
 .S OPLOC=""_$P(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM"),U,3)_","_""
 .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
 .;Get delivery division
 .D GETDIV
 .Q
 ;
 ;Get food production facility for special meals, use 115.17.2
 ;location field 2 which is a pointer to 119.6 (nutrition location)
 ;which points to 119.72 via field 2 (tray service point) which points
 ;to file 119.71 (production facility) field 2.
 I P["OP",D["SM" D
 .S OPLOC=""_$P(NODE,U,3)_","_""
 .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
 .;Get delivery division
 .D GETDIV
 .Q
 ;
 ;Get food production facility for outpatient guest meals, use
 ;115.18.4 (outpatient location) then use 119.6 nutrition location
 ;which points to 119.72 (production facility) field 2.
 I P["OP",D["GM" D
 .S OPLOC=""_$P(NODE,U,5)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
 .S ECXFPF=$$GET1^DIQ(119.72,""_TRSVP_","_"",2,"I")
 .;Get delivery division
 .D GETDIV
 .Q
 ;
 ;Get delivery location type for patients; with inpatients the type of
 ;service needs to be pulled from the admission node, with outpatients
 ;the type of service needs to be pulled from different nodes and use
 ;field 101 of Nutrition Location file (#119.6). Delivery location
 ;types only set for the following meals:
 ;   Inpatient with a production diet
 ;   Outpatient with a recurring meal
 ;   Outpatient with a special meal
 ;   Outpatient with a guest meal
 ;   all other meals are null
 I P="INP",D="PD" D
 .S ECXDLT=$P($G(NODE),U,8)
 I P="OP",((D="RM")!(D="SM")) D
 .S ECXDLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,3)_","_"",101,"E"),1)
 I P="OP",D="GM" D
 .S ECXDLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,5)_","_"",101,"E"),1)
 ;
 ;Delivery feeder location
 I ECXDLT="C" S ECXDFL=$P(NODE,U,8) D
 .S ECXDFL=$E($$GET1^DIQ(119.72,ECXDFL,2,"E"),1,10)
 I (ECXDLT["T")!(ECXDLT["D") D
 .S MASWARD=$O(^FH(119.6,$S(WARD:+WARD,+OPLOC:+OPLOC,1:""),"W","B",0))
 .S ECXDFL=$$GET1^DIQ(42,+MASWARD,44,"I")
 Q 1
 ;
GETDIV ;Get divisions and food production facility
 ;Init variables
 N IEN,SIEN
 S (ECXFDD,ECXFPF,ECXFPD)=""
 S IEN=$$GET1^DIQ(119.72,+TRSVP,2,"I")
 Q:'IEN
 ;Get delivery division
 S SIEN=""_+TRSVP_";FH(119.72,"
 S ECXFDD=$O(^ECX(728.46,"B",SIEN,ECXFDD))
 S ECXFDD=""_$$GET1^DIQ(728.46,ECXFDD,1,"I")_","_""
 S ECXFDD=$$GET1^DIQ(4,ECXFDD,99,"E")
 ;Get production division and food production facility
 S IEN=""_IEN_";FH(119.71,"
 S ECXFPF=$O(^ECX(728.46,"B",IEN,ECXFPF))
 S ECXFPD=""_$$GET1^DIQ(728.46,ECXFPF,1,"I")_","_""
 S ECXFPD=$$GET1^DIQ(4,ECXFPD,99,"E")
 S ECXFPF=$E($$GET1^DIQ(728.46,ECXFPF,.01,"E"),1,10)
 Q