source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXUTL6.m@ 1742

ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ; 11/28/07 11:34am
 ;;3.0;DSS EXTRACTS;**92,105**;Dec 22, 1997;Build 70
 ;
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, 118.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(118.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,CRSVP,OPLOC,MASWARD
 S (CRSVP,TRSVP)=0,(WARD,DLT,DFL,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")
 .S CRSVP=$$GET1^DIQ(119.6,WARD,4,"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 FPF=$$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 DLT=$P($G(NODE),U,8)
 I P="OP",((D="RM")!(D="SM")) D
 .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,3)_","_"",101,"E"),1)
 I P="OP",D="GM" D
 .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,5)_","_"",101,"E"),1)
 ;
 ;Delivery feeder location
 I DLT="C" D
 .S DFL=$E($$GET1^DIQ(119.6,WARD,4,"E"),1,10)
 .S IEN=$$GET1^DIQ(119.72,+CRSVP,2,"I")
 .S IEN=""_IEN_";FH(119.71,"
 .S FPF=$O(^ECX(728.46,"B",IEN,FPF))
 .S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10)
 I (DLT["T")!(DLT["D") D
 .I P="INP" D
 ..S MASWARD=$O(^FH(119.6,+WARD,"W","B",0))
 ..S DFL=$$GET1^DIQ(42,+MASWARD,44,"I")
 .I P="OP" D
 ..S DFL=$O(^FH(119.6,+OPLOC,"L","B",0))
 I (DLT=""),"SFTFSO"[D D
 .S DFL=$S(TRSVP:$$GET1^DIQ(119.6,WARD,3,"E"),1:$$GET1^DIQ(119.6,WARD,4,"E"))
 Q 1
 ;
GETDIV ;Get divisions and food production facility
 ;Init variables
 N IEN,SIEN
 S (FDD,FPF,FPD)=""
 S IEN=$$GET1^DIQ(119.72,+TRSVP,2,"I")
 Q:'IEN
 ;Get delivery division
 S SIEN=""_+TRSVP_";FH(119.72,"
 S FDD=$O(^ECX(728.46,"B",SIEN,FDD))
 S FDD=""_$$GET1^DIQ(728.46,FDD,1,"I")_","_""
 S FDD=$$GET1^DIQ(4,FDD,99,"E")
 ;Get production division and food production facility
 S IEN=""_IEN_";FH(119.71,"
 S FPF=$O(^ECX(728.46,"B",IEN,FPF))
 S FPD=""_$$GET1^DIQ(728.46,FPF,1,"I")_","_""
 S FPD=$$GET1^DIQ(4,FPD,99,"E")
 S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10)
 Q
 ;
SUR(CRST,STCD,CLINIC) ;Surgery stop codes and clinic (outpatients only)
 ;Init variables
 S (CRST,STCD,CLINIC)=""
 ;Quit if not outpatient
 Q:$P(EC0,U,12)'="O" ""
 ;Get stop codes (outpatient only)
 I $P(EC0,U,12)="O" D
 .;Get credit stop code (outpatient only)
 .S CRST=""_$$GET1^DIQ(40.7,""_$$GET1^DIQ(44,$$GET1^DIQ(137.45,$P(EC0,U,4),2,"I")_","_""_","_"",2503,"I")_","_"",1,"E")
 .;Get stop code (outpatient only)
 .S STCD=""_$$GET1^DIQ(40.7,""_$$GET1^DIQ(44,$$GET1^DIQ(137.45,$P(EC0,U,4),2,"I")_","_""_","_"",8,"I")_","_"",1,"E")
 ;Clinic for non-or case use associated clinic else non-or location
 ;If non-or case
 I $P($G(ECNO),U)="Y" S CLINIC=$S($P(EC0,U,21):$P(EC0,U,21),1:$P(ECNO,U,2))
 ;Get stop codes non-or cases
 I $P($G(ECNO),U)="Y" D
 .;Get credit stop code for non-or case
 .S CRST=$$GET1^DIQ(40.7,$$GET1^DIQ(44,CLINIC,2503,"I"),1,"E")
 .;Get stop code for non-or case
 .S STCD=$$GET1^DIQ(40.7,$$GET1^DIQ(44,CLINIC,8,"I"),1,"E")
 ;Clinic, not a non-or case use surgical specialty associated clinic
 I $P($G(ECNO),U)'="Y" S CLINIC=$$GET1^DIQ(137.45,+$P(EC0,U,4),2,"I")
 Q 1
 ;
SURPODX(PRODX,PODX1,PODX2,PODX3,PODX4,PODX5) ;Get postop diagnosis codes
 ;Init variables
 N CODE,I,PODX
 S (PRODX,PODX1,PODX2,PODX3,PODX4,PODX5)="",CODE=0
 ;Check input
 Q:'$D(DATAOP) 0
 ;Get principal postop dx code
 S PRODX=$$GET1^DIQ(80,$P(DATAOP,U,3),.01)
 ;Get other postop dx codes
 S (CODE,I)=0 F  S CODE=$O(^SRO(136,ECD0,4,CODE)) Q:'CODE  Q:I>5  D
 .S I=I+1,PODX="PODX"_I,@PODX=$$GET1^DIQ(80,$P(^SRO(136,ECD0,4,CODE,0),U),.01)
 Q 1