Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL6.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• DSS_EXTRACTS-ECX/ECXUTL6.m (modified) (8 diffs)

FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL6.m

@@ -1 @@
-ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ; 11/28/07 11:34am
- ;;3.0;DSS EXTRACTS;**92,105**;Dec 22, 1997;Build 70
+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
@@ -6 +6 @@
  ;      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
+ ;      d  - diet ien from files 116.2, 116.3, 118, or 118.2
  ;Check input
  I $G(P)=""!'$G(D) Q ""
@@ -13 +13 @@
  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 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_","_""
@@ -28 +28 @@
  ;            location
  ;Init variables
- N WARD,TRSVP,CRSVP,OPLOC,MASWARD
- S (CRSVP,TRSVP)=0,(WARD,DLT,DFL,MASWARD)=""
+ N WARD,TRSVP,OPLOC,MASWARD
+ S TRSVP=0,(WARD,ECXDLT,ECXDFL,MASWARD)=""
  S OPLOC=""
  ;Check input
@@ -38 +38 @@
  ;119.72 (production facility) field 2.
  I P="INP" D
- .S WARD=$P($G(^FHPT(FHDFN,"A",+ECXADM,0)),U,8)
+ .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
@@ -80 +79 @@
  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")
+ .S ECXFPF=$$GET1^DIQ(119.72,""_TRSVP_","_"",2,"I")
  .;Get delivery division
  .D GETDIV
@@ -96 +95 @@
  ;   all other meals are null
  I P="INP",D="PD" D
- .S DLT=$P($G(NODE),U,8)
+ .S ECXDLT=$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)
+ .S ECXDLT=$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)
+ .S ECXDLT=$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"))
+ 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
  ;
@@ -122 +112 @@
  ;Init variables
  N IEN,SIEN
- S (FDD,FPF,FPD)=""
+ 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 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")
+ 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 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)
+ 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
- ;
-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