209 lines
6.6 KiB
Mathematica
209 lines
6.6 KiB
Mathematica
ECXUTL5 ;ALB/JRC - Utilities for DSS Extracts ; 01/18/07 9:04am
|
|
;;3.0;DSS EXTRACTS;**71,84,92,103**;Dec 22, 1997;Build 1
|
|
;
|
|
REPEAT(CHAR,TIMES) ;REPEAT A STRING
|
|
;INPUT : CHAR - Character to repeat
|
|
; TIMES - Number of times to repeat CHAR
|
|
;OUTPUT : s - String of CHAR that is TIMES long
|
|
; "" - Error (bad input)
|
|
;
|
|
;CHECK INPUT
|
|
Q:($G(CHAR)="") ""
|
|
Q:((+$G(TIMES))=0) ""
|
|
;RETURN STRING
|
|
Q $TR($J("",TIMES)," ",CHAR)
|
|
INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;INSERT A STRING INTO ANOTHER
|
|
;INPUT : INSTR - String to insert
|
|
; OUTSTR - String to insert into
|
|
; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
|
|
; LENGTH - Number of characters to clear from OUTSTR
|
|
; (defaults to length of INSTR)
|
|
;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
|
|
; using LENGTH characters
|
|
; "" - Error (bad input)
|
|
;
|
|
;NOTE : This module is based on $$SETSTR^VALM1
|
|
;
|
|
;CHECK INPUT
|
|
Q:('$D(INSTR)) ""
|
|
Q:('$D(OUTSTR)) ""
|
|
S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
|
|
S:('$D(LENGTH)) LENGTH=$L(INSTR)
|
|
;DECLARE VARIABLES
|
|
N FRONT,END
|
|
S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
|
|
S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
|
|
;INSERT STRING
|
|
Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
|
|
TYPE(DFN) ;Determine patient type DBIA #2511
|
|
; input
|
|
; DFN = patient ien
|
|
;
|
|
; output
|
|
; ECXPTYPE = patient type external value from fle 391
|
|
;
|
|
; AC = ACTIVE DUTY MI = MILITARY RETIREE
|
|
; AL = ALLIED VETERAN NO = NON-VETERAN (OTHER)
|
|
; CO = COLLATERAL NS = NSC VETERAN
|
|
; EM = EMPLOYEE SC = SC VETERAN
|
|
; IN = INELIGIBLE TR = TRICARE
|
|
; return value 0 if no data found, 1 if data found
|
|
;
|
|
N TYPE,ECXPTYPE
|
|
;Check input
|
|
Q:'$D(DFN) ""
|
|
S (TYPE,ECXPTYPE)=""
|
|
S TYPE=$G(^DPT(DFN,"TYPE"))
|
|
I 'TYPE Q ECXPTYPE
|
|
S ECXPTYPE=$P($G(^DG(391,TYPE,0)),U,1)
|
|
S ECXPTYPE=$E(ECXPTYPE,1,2)
|
|
Q ECXPTYPE
|
|
CVEDT(DFN,DATE) ;Determine patient CV status DBIA #4156
|
|
; input
|
|
; DFN = patient ien
|
|
;
|
|
; output
|
|
; ECXCVE = combat veteran status eligibility
|
|
; ECXCVEDT = combat veteran eligibility end date
|
|
; ECXCVENC = combat veteran encounter
|
|
;Initialize variables
|
|
N CVSTAT
|
|
S (CVSTAT,ECXCVE,ECXCVEDT,ECXCVENC)=""
|
|
;Check input
|
|
Q:'$D(DFN) 0
|
|
;Call CV API
|
|
S CVSTAT=$$CVEDT^DGCV(DFN,DATE)
|
|
I CVSTAT<1 Q 0
|
|
;Veteran been given CV eligibility
|
|
S ECXCVE=$S($P(CVSTAT,U,3)=1:"Y",$P(CVSTAT,U,3)=0:"E",1:"")
|
|
;Save CV eligibility end date and convert from FM to HL7 format
|
|
S ECXCVEDT=$P(CVSTAT,U,2)
|
|
S ECXCVEDT=$$FMTHL7^XLFDT(ECXCVEDT)
|
|
;Is the veteran eligible for CV in the date of encounter
|
|
S ECXCVENC=$S($P(CVSTAT,U,3)=1:"Y",1:"")
|
|
Q 1
|
|
NPRF ;National patient record flags DBIA #3860
|
|
N ECXARR,FLG
|
|
S ECXNPRFI="",CNT=$$GETACT^DGPFAPI(ECXDFN,"ECXARR"),FLG=""
|
|
I 'CNT Q
|
|
F I=1:1:CNT D Q:FLG
|
|
.I ECXARR(I,"CATEGORY")["NATIONAL" S ECXNPRFI="Y",FLG=1
|
|
Q
|
|
RXPTST(K) ;Rx patient status DBIA #2511
|
|
N ECXDIC,STAT
|
|
S (ECXDIC,STAT)=""
|
|
;Check input
|
|
Q:'$D(K) STAT
|
|
S DA=K,DIC="^PS(53,",DIQ(0)="I",DIQ="ECXDIC",DR="6"
|
|
D EN^DIQ1
|
|
S STAT=$G(ECXDIC(53,K,6,"I"))
|
|
S STAT=$S(STAT=1:"SC",STAT=2:"AA",STAT=3:"OTH",STAT=4:"INP",STAT=5:"NON",1:"")
|
|
Q STAT
|
|
NONVAP(K) ;Non-va prescriber DBIA #10060
|
|
N ECXDIC,NONVAP
|
|
S (ECXDIC,NONVAP)=""
|
|
Q:'$D(K) NONVAP
|
|
S DA=K,DIC="^VA(200,",DIQ(0)="I",DIQ="ECXDIC",DR="53.91"
|
|
D EN^DIQ1
|
|
S NONVAP=$G(ECXDIC(200,K,53.91,"I"))
|
|
I NONVAP S NONVAP="Y"
|
|
Q NONVAP
|
|
DOIVPO(K,L) ;Add destination for outpatient ivp orders
|
|
; Input K - DFN
|
|
; L - Order # from Pharmacy Patient File (#55)
|
|
;
|
|
; Output ordering stop code
|
|
;
|
|
N ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE,DIC,DIQ,DR,DA
|
|
S (ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE)=""
|
|
;Check input
|
|
Q:'K!'(L) SCODE
|
|
;Check treating specialty
|
|
S SCODE=$$TSSC($G(ECXTS)) I SCODE>0 Q SCODE
|
|
;Go to pharmacy patient file (#55) and return value of field (#136)
|
|
S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="100",DR(55.01)="136",DA=K,DA(55.01)=L
|
|
D EN^DIQ1
|
|
S CLINIC=$G(ECXDIC(55.01,L,136,"I"))
|
|
I 'CLINIC Q SCODE
|
|
;Get stop code pointer to file 40.7 from file 44
|
|
S DIC="^SC(",DIQ(0)="I",DIQ="ECXDICA",DR="8",DA=CLINIC D EN^DIQ1
|
|
S SCODE=ECXDICA(44,CLINIC,8,"I")
|
|
;Get stop code external value
|
|
S DIC="^DIC(40.7,",DIQ(0)="E",DIQ="ECXDICB",DR="1",DA=SCODE D EN^DIQ1
|
|
S SCODE=$G(ECXDICB(40.7,SCODE,1,"E"))
|
|
Q SCODE
|
|
;
|
|
DOUDO(K,L) ;Add destination for outpatient udp orders
|
|
; Input K - DFN
|
|
; L - Order # from Pharmacy Patient File (#55)
|
|
;
|
|
; Output ordering stop code
|
|
;
|
|
N ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE,DIC,DIQ,DR,DA
|
|
S (ECXDIC,ECXDICA,ECXDICB,DOIVPO,CLINIC,SCODE)=""
|
|
;Check treating specialty
|
|
S SCODE=$$TSSC($G(ECXTS)) I SCODE>0 Q SCODE
|
|
;Check input
|
|
Q:'K!'(L) SCODE
|
|
S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="62",DR(55.06)="130",DA=K,DA(55.06)=L
|
|
D EN^DIQ1
|
|
S CLINIC=$G(ECXDIC(55.06,L,130,"I"))
|
|
I 'CLINIC Q SCODE
|
|
;Get stop code pointer to file 40.7 from file 44
|
|
S DIC="^SC(",DIQ(0)="I",DIQ="ECXDICA",DR="8",DA=CLINIC D EN^DIQ1
|
|
S SCODE=ECXDICA(44,CLINIC,8,"I")
|
|
;Get stop code external value
|
|
S DIC="^DIC(40.7,",DIQ(0)="E",DIQ="ECXDICB",DR="1",DA=SCODE D EN^DIQ1
|
|
S SCODE=$G(ECXDICB(40.7,SCODE,1,"E"))
|
|
Q SCODE
|
|
;
|
|
PHAAPI(DRUG) ;Call Pharmacy drug file API dbia 4483
|
|
; Input: drug file (#50) ien
|
|
;
|
|
; Output: generic name ^ classification ^ ndc ^ dea hand
|
|
; ^ ndf file entry # ^ psndf va product entry ^
|
|
; price per disp unit ^ dispense unit
|
|
;
|
|
;Initialize variables and scratch global
|
|
N NAME,CLASS,NDC,INV,NDF,P1,P3,PPDU,UNIT,ARRAY,DATA
|
|
S (NAME,CLASS,NDC,INV,NDF,P1,P3,PPDU,ARRAY,DATA)=""
|
|
S ARRAY="^TMP($J,""ECXLIST"")"
|
|
K @ARRAY
|
|
D DATA^PSS50(DRUG,,,,,"ECXLIST")
|
|
I @ARRAY@(0)'>0 Q "^^^^^^"
|
|
S NAME=@ARRAY@(DRUG,.01),CLASS=@ARRAY@(DRUG,2),NDC=@ARRAY@(DRUG,31)
|
|
S INV=@ARRAY@(DRUG,3),P1=$P(@ARRAY@(DRUG,20),U),P3=$P(@ARRAY@(DRUG,22),U),PPDU=@ARRAY@(DRUG,16),UNIT=@ARRAY@(DRUG,14.5)
|
|
K @ARRAY
|
|
Q NAME_U_CLASS_U_NDC_U_INV_U_P1_U_P3_U_PPDU_U_UNIT
|
|
;
|
|
TSSC(X) ;Check treating specialty (ts) and if ts equals any of the following
|
|
;18,23,24,36,41,65,94 then assign predefined code and return value
|
|
;
|
|
; Input: treating specialty
|
|
; Output: Ordering stop code
|
|
;
|
|
S CODE=$S(X=18:293,X=23:295,X=24:290,X=36:294,X=41:296,X=65:291,X=94:292,1:"")
|
|
Q CODE
|
|
;
|
|
PSJ59P5(X) ;Get iv room division
|
|
; Input X - iv room ien
|
|
;
|
|
; Output - field .02 division
|
|
;Init variables
|
|
N DIV S DIV=""
|
|
;Check input
|
|
I 'X Q DIV
|
|
D ALL^PSJ59P5(X,,"ECXDIV")
|
|
S DIV=$P($G(^TMP($J,"ECXDIV",X,.02)),U)
|
|
K ^TMP($J,"ECXDIV")
|
|
Q DIV
|
|
;
|
|
SCRX(IEN) ;Service connected prescription
|
|
;Init variables
|
|
N DIC,DR,DA,ECXDIQ
|
|
;Check input
|
|
I '$G(IEN) Q ""
|
|
S DIC=52,DR="116",DA=IEN,DIQ="ECXDIQ"
|
|
D DIQ^PSODI(DIC,DIC,DR,DA,DIQ)
|
|
Q $S($G(ECXDIQ(52,DA,116))="YES":"Y",$G(ECXDIQ(52,DA,116))="NO":"N",1:"")
|