| 1 | ECXUTL2 ;ALB/JAP - Utilities for DSS Extracts (cont.) ; 6/12/07 6:38am
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**8,13,23,24,33,35,39,46,71,84,92,105**;Dec 22, 1997;Build 70
|
|---|
| 3 | ;
|
|---|
| 4 | ECXDEF(ECXHEAD,ECXPACK,ECXGRP,ECXFILE,ECXRTN,ECXPIECE,ECXVER) ;variables specific to extract from file #727.1
|
|---|
| 5 | ; input
|
|---|
| 6 | ; ECXHEAD = extract header code
|
|---|
| 7 | ; all other formal list parameters passed by reference
|
|---|
| 8 | ; output
|
|---|
| 9 | ; ECXPACK = type field (#7)
|
|---|
| 10 | ; ECXGRP = group field (#9)
|
|---|
| 11 | ; ECXFILE = file number field (#1)
|
|---|
| 12 | ; ECXRTN = routine field (#4)
|
|---|
| 13 | ; ECXPIECE= running piece field (#11)
|
|---|
| 14 | ; ECXVER = dss version
|
|---|
| 15 | N ECXIEN,ECXARR,DIC,DA,DR,DIQ
|
|---|
| 16 | S (ECXPACK,ECXGRP,ECXFILE,ECXRTN,ECXPIECE,ECXVER)="",ECXIEN=0
|
|---|
| 17 | S ECXIEN=+$O(^ECX(727.1,"C",ECXHEAD,ECXIEN))
|
|---|
| 18 | I ECXIEN=0 D Q
|
|---|
| 19 | .D MES^XPDUTL(" ")
|
|---|
| 20 | .D MES^XPDUTL(" It appears that you may have a problem with File #727.1 --")
|
|---|
| 21 | .D MES^XPDUTL(" ")
|
|---|
| 22 | .D MES^XPDUTL(" The "_ECHEAD_" Extract is not properly defined.")
|
|---|
| 23 | .D MES^XPDUTL(" ")
|
|---|
| 24 | .D MES^XPDUTL(" Contact National VISTA Support for further assistance.")
|
|---|
| 25 | .D MES^XPDUTL(" ")
|
|---|
| 26 | .I $E(IOST)="C" D
|
|---|
| 27 | ..S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 28 | ..S DIR(0)="E" W ! D ^DIR K DIR
|
|---|
| 29 | .W !!
|
|---|
| 30 | S DIC="^ECX(727.1,",DA=ECXIEN,DR=".01;1;4;7;9;11",DIQ="ECXARR"
|
|---|
| 31 | D EN^DIQ1
|
|---|
| 32 | S ECXPACK=ECXARR(727.1,ECXIEN,7)
|
|---|
| 33 | ;if this is an inactive extract type, skip it
|
|---|
| 34 | I ECXPACK["Inactive" D Q
|
|---|
| 35 | .D MES^XPDUTL(" ")
|
|---|
| 36 | .D MES^XPDUTL(" The "_ECHEAD_" Extract is no longer active/valid.")
|
|---|
| 37 | .D MES^XPDUTL(" ")
|
|---|
| 38 | .D MES^XPDUTL(" Contact National VISTA Support for further assistance.")
|
|---|
| 39 | .D MES^XPDUTL(" ")
|
|---|
| 40 | .I $E(IOST)="C" D
|
|---|
| 41 | ..S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 42 | ..S DIR(0)="E" W ! D ^DIR K DIR
|
|---|
| 43 | .W !!
|
|---|
| 44 | S ECXGRP=ECXARR(727.1,ECXIEN,9)
|
|---|
| 45 | S ECXFILE=ECXARR(727.1,ECXIEN,1)
|
|---|
| 46 | S ECXRTN="START^"_ECXARR(727.1,ECXIEN,4)
|
|---|
| 47 | S ECXPIECE=ECXARR(727.1,ECXIEN,11)
|
|---|
| 48 | ;version of dss/tsi in Austin as specified by btso
|
|---|
| 49 | S ECXVER=7
|
|---|
| 50 | Q
|
|---|
| 51 | PATDEM(DFN,DT1,PAR,FLG) ; determine patient information
|
|---|
| 52 | ; DFN =
|
|---|
| 53 | ; DT =
|
|---|
| 54 | ; PAR =
|
|---|
| 55 | ; FLG =
|
|---|
| 56 | N DT2,PAT,OK,X
|
|---|
| 57 | D KPATDEM
|
|---|
| 58 | S FLG=$G(FLG),PAR=$S($D(PAR):PAR,1:"1;2;3;4;5;"),DT2=$P(DT1,".")
|
|---|
| 59 | Q:'$$PAT^ECXUTL3(DFN,DT2,PAR,.PAT) 0
|
|---|
| 60 | S ECXMPI=PAT("MPI")
|
|---|
| 61 | I PAR["1" D
|
|---|
| 62 | .S ECXSSN=PAT("SSN"),ECXPNM=PAT("NAME"),ECXDOB=PAT("DOB")
|
|---|
| 63 | .S ECXSEX=PAT("SEX"),ECXREL=PAT("RELIGION"),ECXRACE=PAT("RACE")
|
|---|
| 64 | .S ECXMAR=PAT("MARITAL")
|
|---|
| 65 | .S ECXETH=PAT("ETHNIC"),ECXRC1=PAT("RACE1")
|
|---|
| 66 | I PAR["2" D
|
|---|
| 67 | .S ECXCNTY=PAT("COUNTY"),ECXSTATE=PAT("STATE"),ECXZIP=PAT("ZIP")
|
|---|
| 68 | I PAR["3" D
|
|---|
| 69 | .S ECXPOS=PAT("POS"),ECSC=PAT("SC STAT"),ECXSVC=PAT("SC%")
|
|---|
| 70 | .S ECXVET=PAT("VET"),ECXMEAN=PAT("MEANS"),ECXELIG=PAT("ELIG")
|
|---|
| 71 | .S ECXENRL=PAT("ENROLL LOC")
|
|---|
| 72 | .S ECXERI=PAT("ERI")
|
|---|
| 73 | I PAR["4" S ECXEMP=PAT("EMPLOY")
|
|---|
| 74 | I PAR["5" D
|
|---|
| 75 | .S ECXVIET=PAT("VIETNAM"),ECXAST=PAT("AO STAT"),ECXRST=PAT("IR STAT")
|
|---|
| 76 | .S ECXEST=PAT("EC STAT"),ECXPST=PAT("POW STAT"),ECXPLOC=PAT("POW LOC")
|
|---|
| 77 | .S ECXPHI=PAT("PHI"),ECXMST=PAT("MST STAT"),ECXAOL=PAT("AOL")
|
|---|
| 78 | .S ECXOEF=PAT("ECXOEF"),ECXOEFDT=PAT("ECXOEFDT")
|
|---|
| 79 | I PAR["6" D
|
|---|
| 80 | .S (ECXPAYOR,ECXSAI)="" D VISN19(DFN,.ECXPAYOR,.ECXSAI)
|
|---|
| 81 | I FLG'[3 D
|
|---|
| 82 | .S X=$$PRIMARY(DFN,DT2),ECPTTM=$P(X,U),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3)
|
|---|
| 83 | .S ECPTNPI=$P(X,U,4),ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6)
|
|---|
| 84 | .S ECASNPI=$P(X,U,7)
|
|---|
| 85 | I FLG'[2 D
|
|---|
| 86 | .S ECXINP=$$INP^ECXUTL2(DFN,DT1),ECXA=$P(ECXINP,U),ECXMN=$P(ECXINP,U,2)
|
|---|
| 87 | .S ECXTS=$P(ECXINP,U,3),ECXDOM=$P(ECXINP,U,10),ECXADMDT=$P(ECXINP,U,4)
|
|---|
| 88 | I FLG'[1 S X=$$ENROLLM(DFN)
|
|---|
| 89 | Q 1
|
|---|
| 90 | ;
|
|---|
| 91 | KPATDEM ;
|
|---|
| 92 | K ECXADMDT,ECAO,ECASNPI,ECASPR,ECCLAS,ECCLAS2,ECENV,ECPTNPI,ECPTPR,ECPTTM
|
|---|
| 93 | K ECRE,ECSC,ECXA,ECXAST,ECXCAT,ECXCNTY,ECXEST,ECXENRL,ECXDOB
|
|---|
| 94 | K ECXDOM,ECXELIG,ECXINP,ECXMPI,ECXMN,ECXNM,ECXPHI,ECXPLOC,ECXMEAN,ECXMST
|
|---|
| 95 | K ECXPAYOR,ECXPNM,ECXPOS,ECXPRIOR,ECXPST,ECXRACE,ECXREL,ECXRST,ECXSAI
|
|---|
| 96 | K ECXSEX,ECXSSN,ECXSTAT,ECXSTATE,ECXSVC,ECXTS,ECXVIET,ECXZIP,VA,VAERR
|
|---|
| 97 | K ECXSBGRP
|
|---|
| 98 | Q
|
|---|
| 99 | ENROLLM(DFN,RNDT) ;determines enrollment status, category, priority
|
|---|
| 100 | ;and user enrollee status
|
|---|
| 101 | ; input
|
|---|
| 102 | ; DFN = IEN from Patient file (Required)
|
|---|
| 103 | ; RNDT = Extract Run Date
|
|---|
| 104 | ; output
|
|---|
| 105 | ; ECXSTAT = Enrollment status
|
|---|
| 106 | ; ECXPRIOR = Enrollment priority
|
|---|
| 107 | ; ECXCAT = Enrollment priority
|
|---|
| 108 | ; ECXSBGRP = Enrollment subgroup
|
|---|
| 109 | ; ECXUESTA = User enrollee
|
|---|
| 110 | ; return value 0 if no data found, 1 if data found
|
|---|
| 111 | N CAT,PRIOR,STAT,X,X1,X2,X3,ENRIEN,ENR,FL,SBGRP
|
|---|
| 112 | S (ECXCAT,ECXPRIOR,ECXSTAT,ECXSBGRP,ECXEUSTA)=""
|
|---|
| 113 | I $G(DFN)="" Q 0
|
|---|
| 114 | ;User enrollee status, if current or future date set to 'U'
|
|---|
| 115 | ;DBIA #3989
|
|---|
| 116 | S ECXUESTA=$S($$UESTAT^EASUER(DFN):"U",1:"")
|
|---|
| 117 | ;Patient type
|
|---|
| 118 | S ECXPTYPE=$$TYPE^ECXUTL5(DFN)
|
|---|
| 119 | ;Combat Veteran Status DBIA #4156
|
|---|
| 120 | S X3=$$CVEDT^ECXUTL5(DFN,$S($G(ECD):ECD,$G(ECXDATE):ECXDATE,1:DT))
|
|---|
| 121 | ;enrollment priority DBIA
|
|---|
| 122 | S STAT=$$STATUS^DGENA(DFN),PRIOR=$$PRIORITY^DGENA(DFN)
|
|---|
| 123 | S CAT=$$CATEGORY^DGENA4(DFN,STAT),SBGRP=$$ENRSBGRP^DGENA4(DFN)
|
|---|
| 124 | ;find current enrollment when status=2 or 19
|
|---|
| 125 | I "^2^19^"[("^"_STAT_"^") S ECXSTAT=STAT,ECXPRIOR=PRIOR,ECXCAT=CAT,ECXSBGRP=$S(SBGRP=1:"a",SBGRP=3:"c",SBGRP=5:"e",SBGRP=7:"g",1:"") Q 1
|
|---|
| 126 | ;find previous enrollment
|
|---|
| 127 | S ENRIEN=$$FINDCUR^DGENA(DFN) I ENRIEN="" Q 0
|
|---|
| 128 | I $G(RNDT)="" D NOW^%DTC S RNDT=X
|
|---|
| 129 | S RNDT=($E(RNDT,1,3)-1)_$E(RNDT,4,7),FL=0
|
|---|
| 130 | F S ENRIEN=$$FINDPRI^DGENA(ENRIEN) Q:'ENRIEN D Q:FL
|
|---|
| 131 | . S ENR=$$GET^DGENA(ENRIEN,.ENR)
|
|---|
| 132 | . I "^2^19^"[("^"_ENR("STATUS")_"^"),ENR("EFFDATE")>RNDT D
|
|---|
| 133 | . . S ECXSTAT=ENR("STATUS"),ECXPRIOR=PRIOR,FL=1
|
|---|
| 134 | . . S ECXCAT=$$CATEGORY^DGENA4(DFN,ECXSTAT)
|
|---|
| 135 | . . S ECXSBGRP=$$ENRSBGRP^DGENA4(DFN)
|
|---|
| 136 | . . S ECXSBGRP=$S(SBGRP=1:"a",SBGRP=3:"c",SBGRP=5:"e",SBGRP=7:"g",1:"")
|
|---|
| 137 | I FL Q 1
|
|---|
| 138 | ;no enrollment status found =2 or 19
|
|---|
| 139 | S ECXSTAT=STAT,ECXPRIOR=PRIOR,ECXCAT=CAT,ECXSBGRP=$S(SBGRP=1:"a",SBGRP=3:"c",SBGRP=5:"e",SBGRP=7:"g",1:"")
|
|---|
| 140 | Q 1
|
|---|
| 141 | PRIMARY(ECXDFN,ECXDATE,ECXPREFX) ;determine patient's pc team and pc provider
|
|---|
| 142 | ; input
|
|---|
| 143 | ; ECXDFN = file #2 ien (required)
|
|---|
| 144 | ; ECXDATE = date of interest (required)
|
|---|
| 145 | ; ECXPREFX = prefix for provider data (optional)
|
|---|
| 146 | ; defaults to "2" if not specified otherwise
|
|---|
| 147 | ; output
|
|---|
| 148 | ; ECXPRIME = pc team ien^prefix_pc provider ien^pc provider person
|
|---|
| 149 | ;class^pc provider npi^prefix_assoc pc provider ien^assoc pc provider
|
|---|
| 150 | ;person class^assoc pc provider npi
|
|---|
| 151 | N ECPTTM,ECPTPR,ECCLAS,ECPRIME,ECASPR,ECCLAS2
|
|---|
| 152 | S:'$D(ECXPREFX) ECXPREFX=2 S:(+ECXPREFX=0) ECXPREFX=2
|
|---|
| 153 | ;get pc team data
|
|---|
| 154 | S ECPTTM=+$$OUTPTTM^SDUTL3(ECXDFN,ECXDATE) S:ECPTTM=0 ECPTTM=""
|
|---|
| 155 | ;get primary pc provider data
|
|---|
| 156 | S ECPTPR=+$$OUTPTPR^SDUTL3(ECXDFN,ECXDATE)
|
|---|
| 157 | S ECCLAS="" I ECPTPR>0 S ECCLAS=$$PRVCLASS^ECXUTL(ECPTPR,ECXDATE)
|
|---|
| 158 | N ECXUSRTN S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECPTPR,ECXDATE)
|
|---|
| 159 | S:+ECXUSRTN'>0 ECXUSRTN="" S ECPTNPI=$P(ECXUSRTN,U)
|
|---|
| 160 | S:ECPTPR=0 ECPTPR="" S:ECPTPR]"" ECPTPR=ECXPREFX_ECPTPR
|
|---|
| 161 | ;assoc pc provider call ok if routine scapmca from patch177 is present
|
|---|
| 162 | S ECASPR=""
|
|---|
| 163 | S X="SCAPMCA" X ^%ZOSF("TEST") I $T D
|
|---|
| 164 | .S ECASPR=+$$OUTPTAP^SDUTL3(ECXDFN,ECXDATE)
|
|---|
| 165 | S ECCLAS2="" I ECASPR>0 S ECCLAS2=$$PRVCLASS^ECXUTL(ECASPR,ECXDATE)
|
|---|
| 166 | N ECXUSRTN S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECASPR,ECXDATE)
|
|---|
| 167 | S:+ECXUSRTN'>0 ECXUSRTN="" S ECASNPI=$P(ECXUSRTN,U)
|
|---|
| 168 | S:ECASPR=0 ECASPR="" S:ECASPR]"" ECASPR=ECXPREFX_ECASPR
|
|---|
| 169 | ;assemble
|
|---|
| 170 | S ECXPRIME=ECPTTM_U_ECPTPR_U_ECCLAS_U_ECPTNPI_U_ECASPR_U_ECCLAS2_U_ECASNPI
|
|---|
| 171 | Q ECXPRIME
|
|---|
| 172 | INP(ECXDFN,ECXDATE) ; check for inpatient status
|
|---|
| 173 | ; input
|
|---|
| 174 | ; ECXDFN = file #2 ien (required)
|
|---|
| 175 | ; ECXDATE = date of interest (required)
|
|---|
| 176 | ; output
|
|---|
| 177 | ; ECXINP = patient status^movment # (file #405 ien)
|
|---|
| 178 | ; current treat. spec. (file #42.4 ien)^admission date/time^
|
|---|
| 179 | ; current ward (file #42 ien)^discharge date/time^
|
|---|
| 180 | ; ward provider^attending phys.^ward (file #44 ien);facility
|
|---|
| 181 | ; (file #40.8 ien);dss dept^dom
|
|---|
| 182 | ; where patient status = I for inpatient
|
|---|
| 183 | ; = O for outpatient
|
|---|
| 184 | N DFN,DSSDEPT,ECA,ECADM,ECMN,ECTS,ECWARD,ECDC,ECXINP,ECXPRO
|
|---|
| 185 | N ECXATP,ECXDD,ECXDOM,ECXPROF,ECXPWP,ECXWW,FAC,VAIP,WRD,ECXPWPPC
|
|---|
| 186 | N ECXATPPC
|
|---|
| 187 | D FIELD^DID(405,.19,,"SPECIFIER","ECXDD")
|
|---|
| 188 | S ECXPROF=$E(+$P(ECXDD("SPECIFIER"),"P",2)) K ECXDD
|
|---|
| 189 | ;- Inpat/outpat indicator (ECA) initially set to "O" (outpatient)
|
|---|
| 190 | S DFN=ECXDFN,ECA="O"
|
|---|
| 191 | S (DSSDEPT,ECMN,ECTS,ECADM,ECWARD,ECDC,ECXATP,ECXPWP,ECXWW,WRD,FAC,ECXPWPPC,ECXATPPC)=""
|
|---|
| 192 | S VAIP("D")=ECXDATE D IN5^VADPT
|
|---|
| 193 | S ECMN=$G(VAIP(1))
|
|---|
| 194 | I ECMN D
|
|---|
| 195 | .S ECTS=+$P($G(^DIC(45.7,+VAIP(8),0)),U,2) S:ECTS=0 ECTS=""
|
|---|
| 196 | .;- Get inpat/outpat indicator
|
|---|
| 197 | .S ECA=$$INOUTP^ECXUTL4(ECTS)
|
|---|
| 198 | .S ECADM=+$G(VAIP(13,1)) S:ECADM=0 ECADM=""
|
|---|
| 199 | .S ECWARD=+$G(VAIP(5)) S:ECWARD=0 ECWARD=""
|
|---|
| 200 | .I ECWARD D
|
|---|
| 201 | ..S WRD=+$P($G(^DIC(42,+ECWARD,44)),U)
|
|---|
| 202 | ..S FAC=$P($G(^DIC(42,+ECWARD,0)),U,11)
|
|---|
| 203 | ..S DSSDEPT=$P($G(^ECX(727.4,ECWARD,0)),U,2)
|
|---|
| 204 | .S ECXWW=WRD_";"_FAC_";"_DSSDEPT,ECDC=+$G(VAIP(17,1)) S:ECDC=0 ECDC=""
|
|---|
| 205 | .S ECXPWP=+VAIP(7) S:ECXPWP=0 ECXPWP=""
|
|---|
| 206 | .S ECXATP=+VAIP(18) S:ECXATP=0 ECXATP=""
|
|---|
| 207 | .S ECXPWPPC=$$PRVCLASS^ECXUTL(ECXPWP,ECADM)
|
|---|
| 208 | .S ECXATPPC=$$PRVCLASS^ECXUTL(ECXATP,ECADM)
|
|---|
| 209 | .;prefix file #200 iens
|
|---|
| 210 | .S:ECXPWP ECXPWP=ECXPROF_ECXPWP S:ECXATP ECXATP=ECXPROF_ECXATP
|
|---|
| 211 | S ECXDOM=$P($G(^ECX(727.831,+ECTS,0)),U,2)
|
|---|
| 212 | S ECXINP=ECA_U_ECMN_U_ECTS_U_ECADM_U_ECWARD_U_ECDC_U_ECXPWP_U_ECXATP_U_ECXWW_U_ECXDOM_U_ECXPWPPC_U_ECXATPPC
|
|---|
| 213 | Q ECXINP
|
|---|
| 214 | VISN19(ECXDFN,ECXPAYOR,ECXSAI) ;visn 19 sharing agreement data
|
|---|
| 215 | ; input ECXDFN = patient file ien
|
|---|
| 216 | ; output ECXPAYOR, ECXSAI (passed by reference)
|
|---|
| 217 | N JJ,ALIAS,INSUR,DIC,DIQ,DA,DR,ECXARY,ECXERR,ECXDA
|
|---|
| 218 | S (ECXPAYOR,ECXSAI)=""
|
|---|
| 219 | D GETS^DIQ(2,ECXDFN,"1*,","I","ECXARY","ECXERR")
|
|---|
| 220 | I $D(ECXERR) Q
|
|---|
| 221 | S JJ=0 F S JJ=$O(ECXARY(2.01,JJ)) Q:JJ="" D I ECXPAYOR]"" Q
|
|---|
| 222 | . S ALIAS=$G(ECXARY(2.01,JJ,.01,"I"))
|
|---|
| 223 | . S ECXPAYOR=$S(ALIAS="SHARING AGREEMENT":"A",ALIAS="TRICARE":"B",ALIAS="CAT C":"C",ALIAS="CATEGORY C":"C",ALIAS="CHAMPVA":"D",ALIAS="CHAMPUS":"E",1:"")
|
|---|
| 224 | . W !,$G(CNT)+1
|
|---|
| 225 | . W !,"The value of ECXPAYOR is: ",ECXPAYOR
|
|---|
| 226 | ;K ECXARY,ECXERR
|
|---|
| 227 | I ECXPAYOR]"" D GETS^DIQ(2,ECXDFN,".3121*,","I","ECXARY","ECXERR") D
|
|---|
| 228 | . I $D(ECXERR) Q
|
|---|
| 229 | . S JJ=0,ECXDA=$O(ECXARY(2.312,JJ)) I ECXDA="" Q
|
|---|
| 230 | . S DA=$G(ECXARY(2.312,ECXDA,.01,"I")) I DA="" Q
|
|---|
| 231 | . S INSUR=$$GET1^DIQ(36,DA,".01","I","","ECXERR")
|
|---|
| 232 | . I '$D(ECXERR) S ECXSAI=$E(ECXARY(2.312,ECXDA,.01,"I"),1,11)
|
|---|
| 233 | Q
|
|---|
