Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXUTL6

ECXUTL6.m

Go to the documentation of this file.
  1. ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ;4/8/19 11:11
  1. ;;3.0;DSS EXTRACTS;**92,105,112,119,132,154,170,173,174**;Dec 22, 1997;Build 33
  1. ;
  1. NUTKEY(P,D) ;Generate n&fs feeder key
  1. ;Required variables
  1. ; p - diet type production diet, standing orders, supplemental
  1. ; feedings, or tube feedings.
  1. ; d - diet ien from files 116.2, 118.3, 118, or 118.2
  1. ;Check input
  1. I $G(P)=""!'$G(D) Q ""
  1. ;Init variables
  1. N PRO,IENS,CODE,DIET
  1. S (PRO,IENS,CODE,DIET)=0
  1. S PRO=$O(^ECX(728.45,"B",P,PRO))
  1. S CODE=D_$S(P="PD":";FH(116.2,",P="SO":";FH(118.3,",P="SF":";FH(118,",P="TF":";FH(118.2,",1:"")
  1. S DIET=0,DIET=$O(^ECX(728.45,+PRO,1,"B",CODE,DIET))
  1. S IENS=""_DIET_","_PRO_","_""
  1. Q $$GET1^DIQ(728.451,IENS,1)
  1. ;
  1. NUTLOC(P,D,FPD,FDD,FPF,DLT,DFL) ;Define nutrition fields
  1. ;Required variables
  1. ; p - patient status, inpatient or outpatient
  1. ;
  1. ; d - diet type production diet, standing orders, supplemental
  1. ; feedings, or tube feedings.
  1. ; Output: food production division, food delivery division, food
  1. ; production facility, food delivery type, delivery feeder
  1. ; location
  1. ;Init variables
  1. N WARD,TRSVP,CRSVP,OPLOC,MASWARD
  1. S (CRSVP,TRSVP)=0,(WARD,DLT,DFL,MASWARD)=""
  1. S OPLOC=""
  1. ;Check input
  1. I $G(P)=""!($G(D)="")!'($G(FHDFN)) Q ""
  1. ;Get food production facility for inpatient, use 115.1.13 (dietetic
  1. ;ward) field which points 119.6 (nutrition location), field 3 (tray
  1. ;service point) or field 4 (cafeteria service point), which points to
  1. ;119.72 (production facility) field 2.
  1. I P="INP" D
  1. .N VAHOW
  1. .K ^UTILITY("VAIP",$J)
  1. .S DFN=$P($G(^FHPT(FHDFN,0)),U,3)
  1. .S VAIP("D")=$G(SDATE),VAHOW=2
  1. .D IN5^VADPT
  1. .S MASWARD=+^UTILITY("VAIP",$J,5)
  1. .S WARD=$O(^FH(119.6,"AW",+MASWARD,0))
  1. .S:+WARD'>0 WARD=""
  1. .S TRSVP=$$GET1^DIQ(119.6,WARD,3,"I")
  1. .S CRSVP=$$GET1^DIQ(119.6,WARD,4,"I")
  1. .;Get divisions
  1. .D GETDIV
  1. .Q
  1. ;
  1. ;Get food production facility for OP Supplemental feedings,
  1. ;use 115.1.13 (dietetic
  1. ;ward) field which points 119.6 (nutrition location), field 3 (tray
  1. ;service point) or field 4 (cafeteria service point), which points to
  1. ;119.72 (production facility) field 2.
  1. I P["OP",D["SF" D
  1. .S OPLOC=""_$P(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM"),U,3)_","_""
  1. .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
  1. .;Get delivery division
  1. .D GETDIV
  1. .Q
  1. ;Get food production facility for OP Standing Orders,
  1. ;use 115.1.13 (dietetic
  1. ;ward) field which points 119.6 (nutrition location), field 3 (tray
  1. ;service point) or field 4 (cafeteria service point), which points to
  1. ;119.72 (production facility) field 2.
  1. I P["OP",D["SO" D
  1. .S OPLOC=""_$P(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM"),U,3)_","_""
  1. .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
  1. .;Get delivery division
  1. .D GETDIV
  1. .Q
  1. ;Get food production facility for outpatient recurring meal, use
  1. ;115.16.2 (outpatient location) which points to file 119.6 (nutrition
  1. ;location) field 3 (tray service point) or field 4 (cafeteria service
  1. ;point), which points to 119.72 (production facility) field 2.
  1. I P["OP",D["RM" D
  1. .S OPLOC=""_$P(NODE,U,3)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
  1. .D GETDIV
  1. .Q
  1. ;
  1. ;Get food production facility for outpatient tube feeding, use
  1. ;115.16.2 (outpatient location) then use 119.6 nutrition location
  1. ;which points to 119.72 field 2.
  1. I P["OP",D["TF" D
  1. .S OPLOC=""_$P(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM"),U,3)_","_""
  1. .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
  1. .;Get delivery division
  1. .D GETDIV
  1. .Q
  1. ;
  1. ;Get food production facility for special meals, use 115.17.2
  1. ;location field 2 which is a pointer to 119.6 (nutrition location)
  1. ;which points to 119.72 via field 2 (tray service point) which points
  1. ;to file 119.71 (production facility) field 2.
  1. I P["OP",D["SM" D
  1. .S OPLOC=""_$P(NODE,U,3)_","_""
  1. .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
  1. .;Get delivery division
  1. .D GETDIV
  1. .Q
  1. ;
  1. ;Get food production facility for outpatient guest meals, use
  1. ;115.18.4 (outpatient location) then use 119.6 nutrition location
  1. ;which points to 119.72 (production facility) field 2.
  1. I P["OP",D["GM" D
  1. .S OPLOC=""_$P(NODE,U,5)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
  1. .S FPF=$$GET1^DIQ(119.72,""_TRSVP_","_"",2,"I")
  1. .;Get delivery division
  1. .D GETDIV
  1. .Q
  1. ;
  1. ;Get delivery location type for patients; with inpatients the type of
  1. ;service needs to be pulled from the admission node, with outpatients
  1. ;the type of service needs to be pulled from different nodes and use
  1. ;field 101 of Nutrition Location file (#119.6). Delivery location
  1. ;types only set for the following meals:
  1. ; Inpatient with a production diet
  1. ; Outpatient with a recurring meal
  1. ; Outpatient with a special meal
  1. ; Outpatient with a guest meal
  1. ; all other meals are null
  1. I P="INP",D="PD" D
  1. .S DLT=$P($G(NODE),U,8)
  1. I P="OP",((D="RM")!(D="SM")) D
  1. .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,3)_","_"",101,"E"),1)
  1. I P="OP",D="GM" D
  1. .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,5)_","_"",101,"E"),1)
  1. ;
  1. ;Delivery feeder location
  1. I DLT="C" D
  1. .S DFL=$E($$GET1^DIQ(119.6,WARD,4,"E"),1,10)
  1. .S IEN=$$GET1^DIQ(119.72,+CRSVP,2,"I")
  1. .S IEN=""_IEN_";FH(119.71,"
  1. .S FPF=$O(^ECX(728.46,"B",IEN,FPF))
  1. .S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10)
  1. I (DLT["T")!(DLT["D") D
  1. .I P="INP" D
  1. ..S DFL=$$GET1^DIQ(42,+MASWARD,44,"I")
  1. .I P="OP" D
  1. ..S DFL=$O(^FH(119.6,+OPLOC,"L","B",0))
  1. I (DLT=""),"SFTFSO"[D D
  1. .S DFL=$S(TRSVP:$$GET1^DIQ(119.6,+WARD,3,"E"),1:$$GET1^DIQ(119.6,+WARD,4,"E"))
  1. Q 1
  1. ;
  1. GETDIV ;Get divisions and food production facility
  1. ;Init variables
  1. N IEN,SIEN,SVP
  1. S (FDD,FPF,FPD)=""
  1. S SVP=$S(TRSVP:TRSVP,CRSVP:CRSVP,1:"")
  1. S IEN=$$GET1^DIQ(119.72,+SVP,2,"I")
  1. Q:'IEN
  1. ;Get delivery division
  1. S SIEN=""_+SVP_";FH(119.72,"
  1. S FDD=$O(^ECX(728.46,"B",SIEN,FDD))
  1. S FDD=""_$$GET1^DIQ(728.46,FDD,1,"I")_","_""
  1. S FDD=$$GET1^DIQ(4,FDD,99,"E")
  1. ;Get production division and food production facility
  1. S IEN=""_IEN_";FH(119.71,"
  1. S FPF=$O(^ECX(728.46,"B",IEN,FPF))
  1. S FPD=""_$$GET1^DIQ(728.46,FPF,1,"I")_","_""
  1. S FPD=$$GET1^DIQ(4,FPD,99,"E")
  1. S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10)
  1. Q
  1. ;
  1. SUR(CRST,STCD,CLINIC) ;Surgery stop codes and clinic (outpatients only)
  1. ;Quit if not outpatient
  1. I ECXA="I" Q ;174 Only set stop code, credit stop, and clinic if patient is an outpatient
  1. S CLINIC=$S($P(EC0,U,21):$P(EC0,U,21),$P(ECNO,U,2):$P(ECNO,U,2),1:$$GET1^DIQ(137.45,$P(EC0,U,4),2,"I")) ;174 Set clinic to associated clinic or non-OR location or surgical specialty's associated clinic
  1. ;Next, get stop code from file 728.44, if not found get it from file 44, if not found default to 435 if it's a non-OR procedure, otherwise 429
  1. S STCD=$P($G(^ECX(728.44,+CLINIC,0)),U,4) S:STCD="" STCD=$$GET1^DIQ(40.7,$$GET1^DIQ(44,+CLINIC,8,"I"),1,"E") S:STCD="" STCD=$S($P(ECNO,U)="Y":435,1:429) ;174
  1. S CRST=$P($G(^ECX(728.44,+CLINIC,0)),U,5) S:CRST="" CRST=$$GET1^DIQ(40.7,$$GET1^DIQ(44,+CLINIC,2503,"I"),1,"E") ;174 Set credit stop code to value in 728.44 else from file 44
  1. Q
  1. ;
  1. SURPODX(PRODX,PODX1,PODX2,PODX3,PODX4,PODX5) ;Get postop diagnosis codes
  1. ;Init variables
  1. N CODE,I,PODX
  1. S (PRODX,PODX1,PODX2,PODX3,PODX4,PODX5)="",CODE=0
  1. ;Check input
  1. Q:'$D(DATAOP) 0
  1. ;Get principal postop dx code
  1. I $P(DATAOP,U,3)'="" S PRODX=$$CODEC^ICDEX(80,$P(DATAOP,U,3)) ;154
  1. ;Get other postop dx codes
  1. S (CODE,I)=0 F S CODE=$O(^SRO(136,ECD0,4,CODE)) Q:'CODE Q:I>5 D
  1. .S I=I+1,PODX="PODX"_I I $P(^SRO(136,ECD0,4,CODE,0),U)'="" S @PODX=$$CODEC^ICDEX(80,$P(^SRO(136,ECD0,4,CODE,0),U)) ;154
  1. Q 1
  1. ;
  1. LOINC(ARRAY) ;Get DSS lab test information out of DSS LOINC CODE (#727.29) file
  1. ;Input
  1. ; ARRAY(LOINC-CK) := array of valid LOINC (#727.29 DSS LOINC CODE)
  1. ; entries with their check digit
  1. ; or,
  1. ; ARRAY("ALL") := request for all LOINC entries
  1. ;Output
  1. ; ^TMP($J,"EXCUTL6",LOINC-CK) =
  1. ; zero node of file 727.29 pieces 1 thru 4
  1. ; piece 1 := LOINC-CK (LOINC-check digit)
  1. ; piece 2 := DSS lar test number
  1. ; piece 3 := DSS test name
  1. ; piece 4 := DSS Reporting units
  1. ; piece 5 := LOINC name
  1. ; piece 6 := pointer to LAB LOINC (#95.3) code entry
  1. ; (delimited by "^")
  1. ; -1 := not a valid loinc entry from file 727.29
  1. ; -2 := no dss lar test number associated with loinc
  1. ;
  1. ; ^TMP($J,"ECXUTL6",LOINC-CK,WKLD,SPEC/-or-"DEFAULT",LTEST)=
  1. ; piece 1 := WKLD Code (external)
  1. ; piece 2 := specimen (external) or "DEFAULT LOINC"
  1. ; piece 3 := laboratory test (external)
  1. ; piece 4:= local LOINC code external
  1. ; (delimited by "^")
  1. ;
  1. ;
  1. I '$D(ARRAY) Q
  1. K ^TMP($J,"ECXUTL6")
  1. N LOINCCK,LIEN,SPEC,EC0,WKLD,WKLD0,TA,LRASSV,LOINCPTR,LTEST,LLNC,LLNCP,SPECD
  1. S LOINCCK=""
  1. I $D(ARRAY("ALL")) D
  1. . F S LOINCCK=$O(^ECX(727.29,"B",LOINCCK)) Q:'LOINCCK D EXT
  1. E D
  1. . F S LOINCCK=$O(ARRAY(LOINCCK)) Q:'LOINCCK D EXT
  1. Q
  1. ;
  1. EXT I '$D(^ECX(727.29,"B",LOINCCK)) S ^TMP($J,"ECXUTL6",LOINCCK)=-1_"^no entry in DSS LOINC CODE (#727.29)." Q
  1. S LIEN=$O(^ECX(727.29,"B",LOINCCK,0))
  1. I '$P(^ECX(727.29,LIEN,0),U,2) S ^TMP($J,"ECXUTL6",LOINCCK)=-2_"^no dss test number found." Q
  1. S EC0=^ECX(727.29,LIEN,0)
  1. S ^TMP($J,"ECXUTL6",LOINCCK)=EC0_"^"
  1. S LOINCPTR=""
  1. ;**Lexicon LOINC Code - test whether LEX*2*75 installed.
  1. ; Else, get directly from file #95.3
  1. S X="LEXLR" X ^%ZOSF("TEST") I '$T D
  1. . I LOINCCK=$$GET1^DIQ(95.3,$P(LOINCCK,"-"),.01) D
  1. . . S LOINCPTR=$$GET1^DIQ(95.3,$P(LOINCCK,"-"),.01,"I")
  1. S X="LEXLR" X ^%ZOSF("TEST") I $T D
  1. . S LOINCPTR=$$CHKCODE^LEXLR(LOINCCK) ;DBIA5547
  1. ;**
  1. I LOINCPTR D
  1. . S ^TMP($J,"ECXUTL6",LOINCCK)=^TMP($J,"ECXUTL6",LOINCCK)_LOINCPTR
  1. . S WKLD=0 F S WKLD=$O(^LAM("AI",LOINCPTR,WKLD)) Q:'WKLD D
  1. . . S SPEC=0 F S SPEC=$O(^LAM("AI",LOINCPTR,WKLD,SPEC)) Q:'SPEC D
  1. . . . S TA=0
  1. . . . F S TA=$O(^LAM(WKLD,5,SPEC,1,TA)) Q:'TA D
  1. . . . . S SPECD=^LAM(WKLD,5,SPEC,1,TA,0)
  1. . . . . S LTEST=$P(SPECD,"^",4)
  1. . . . . I LTEST,($P($G(^LAB(60,LTEST,64)),"^",2)=WKLD),($$GET1^DIQ(60,LTEST,3,"I")'="N") D
  1. . . . . . S ^TMP($J,"ECXUTL6",LOINCCK,WKLD,SPEC,LTEST)=$$GET1^DIQ(64,WKLD,.01)_"^"_$$GET1^DIQ(61,SPEC,.01)_"^"_$$GET1^DIQ(60,LTEST,.01)_"^"_LOINCCK
  1. Q
  1. ;
  1. INPUTT ;
  1. N DIC S DIC="^DIC(40.7,",DIC(0)="EMZ",DIC("S")="I '$P(^(0),U,3)&($L($P(^(0),U,2)'=3)) Q"
  1. D ^DIC K:Y<0 X Q:Y<0
  1. S X=$S($D(Y(0)):$P(Y(0),U,2),1:"") K:X=""!($L(X)'=3) X K DIC
  1. Q
  1. ;
  1. ISASIH(MVMT,TYPE) ;170 Section added to determine if patient is ASIH other facility at movement date/time
  1. N ASIH,VAIP,DFN
  1. S ASIH=0
  1. S:TYPE=2 VAIP("E")=MVMT
  1. S:TYPE=3 VAIP("D")=$$FMADD^XLFDT($P(^DGPM(MVMT,0),U),,,,-1)
  1. S DFN=$P($G(^DGPM(MVMT,0)),U,3)
  1. D IN5^VADPT
  1. I "^43^45^46^"[("^"_+VAIP(4)_"^") S ASIH=1
  1. Q ASIH
  1. ;
  1. NEEDADR(TYPE,MVMT,EXTRACT) ;170 Section added to determine if an admission or discharge record for the ASIH other facility episode of care is needed
  1. N REC,VAIP,DFN,NEXTMO ;173
  1. S NEXTMO=$$NEXTMO(ECED) ;173 Get year/month for next month
  1. S REC=1
  1. S VAIP("E")=MVMT
  1. S DFN=$P($G(^DGPM(MVMT,0)),U,3)
  1. D IN5^VADPT
  1. I TYPE="TRAN"&(EXTRACT="ADM") I "^43^45^46^"[("^"_$P($G(VAIP(15,3)),U)_"^") S REC=0
  1. I TYPE="TRAN"&(EXTRACT="MOV") D ;173
  1. .I $G(VAIP(16))="" S REC=0 S ^XTMP("ECXMOV",NEXTMO,MVMT)="" Q ;173 If there isn't a "next" movement, save it for next month
  1. .I $P($G(VAIP(16,1)),U)'>ECSD S REC=0 Q ;173 Don't create a record if it's before the extract start date
  1. .I $P($G(VAIP(16,1)),U)'>ECED I "^43^45^46^"[("^"_$P($G(VAIP(16,3)),U)_"^")!(+$G(VAIP(16,2))'=2) S REC=0 Q ;173 If next movement in timeframe and it's not continuing ASIH or a discharge then create a record
  1. .I $P($G(VAIP(16,1)),U)>ECED S REC=0 I $$ECXYM^ECXUTL($P($G(VAIP(16,1)),U))>$$ECXYM^ECXUTL(ECED) S ^XTMP("ECXMOV",NEXTMO,MVMT)="" ;173 If next movement is after extract end date and is in the next month, save it
  1. I TYPE="DIS" I "^43^45^46^"'[("^"_$P($G(VAIP(15,3)),U)_"^") S REC=0
  1. Q REC_"^"_$S(REC&(EXTRACT="MOV")&(TYPE="TRAN"):$G(VAIP(16)),REC:MVMT,1:"")
  1. ;
  1. NEXTMO(DATE) ;173 Given a date, determine the following month and return in year_month format (ex. 201811 for 11/2018)
  1. N NEXT,DTSTR
  1. S NEXT=""
  1. Q:DATE="" NEXT
  1. S DTSTR=$E(DATE,1,5)_"01" ;Set DTSTR to first of the month
  1. S DTSTR=$$FMADD^XLFDT(DTSTR,32) ;Get date 32 days from the 1st of the previous month
  1. S DTSTR=$$FMADD^XLFDT(DTSTR,-($E(DTSTR,6,7))) ;Subtract number of days into next month to get the last day of the previous month
  1. S DTSTR=$$FMADD^XLFDT(DTSTR,1) ;Add one day to get first day of next month
  1. S NEXT=$$ECXYM^ECXUTL(DTSTR) ;Convert FM date to year_month format
  1. Q NEXT