VistA-WorldVistAEHR/r/DSS_EXTRACTS-ECX/ECXUTL6.m

129 lines
4.6 KiB
Mathematica

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