PXRMMSER ;SLC/PKR,AJB - Computed findings for military service information. ;12/17/2019
;;2.0;CLINICAL REMINDERS;**11,12,21,24,26,42**;Feb 04, 2005;Build 245
;
;===============
AORANGE(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
;finding will be true if the agent orange exposure registration
;date is in the date range specified by Beginning Date/Time
;and Ending Date/Time. VA-AGENT ORANGE EXPOSURE.
N RDATE
S NFOUND=0
D GETSVCD(DFN)
S TEST=^TMP($J,"SVC",DFN,2)
I 'TEST Q
S RDATE=+$P(^TMP($J,"SVC",DFN,2,1),U,1)
I (RDATE=0)!(RDATE<BDT)!(RDATE>EDT) S TEST=0 Q
S NFOUND=1
S TEST(NFOUND)=1,DATE(NFOUND)=RDATE
S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=$P(^TMP($J,"SVC",DFN,2,5),U,2)
S TEXT(NFOUND)="Agent orange exposure registration date: "_$$FMTE^XLFDT(RDATE,"5Z")_"; location: "_DATA(NFOUND,"LOCATION")
Q
;
;===============
COMBAT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
;finding will be true if combat service is found in the
;date range the date range specified by Beginning Date/Time
;and Ending Date/Time. VA-COMBAT SERVICE.
N FDATE,TDATE
S NFOUND=0
D GETSVCD(DFN)
S TEST=^TMP($J,"SVC",DFN,5)
I 'TEST Q
S FDATE=$P(^TMP($J,"SVC",DFN,5,1),U,1)
S TDATE=$P(^TMP($J,"SVC",DFN,5,2),U,1)
I $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O" S TEST=0 Q
S NFOUND=1
S TEST(NFOUND)=1,DATE(NFOUND)=FDATE
S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=$P(^TMP($J,"SVC",DFN,5,3),U,2)
S TEXT(NFOUND)="Combat service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_DATA(NFOUND,"LOCATION")
Q
;
;===============
CVELIG(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;combat vet eligiblity data. VA-COMBAT VET ELIGIBILITY.
N CV,EDATE,ELIG,RESULT
;DBIA #4156
S RESULT=$$CVEDT^DGCV(DFN,$$NOW^PXRMDATE)
;RESULT=(1,0,-1)^End Date (if populated, otherwise null)^CV
; (piece 1) 1 - qualifies as a CV
; 0 - does not qualify as a CV
; -1 - bad DFN or date
; (piece 3) 1 - vet was eligible on date specified (or DT)
; 0 - vet was not eligible on date specified (or DT)
S CV=$P(RESULT,U,1),EDATE=$P(RESULT,U,2),ELIG=$P(RESULT,U,3)
I 'CV S NFOUND=0 Q
S NFOUND=1
S TEST(NFOUND)=CV,DATE(NFOUND)=$$NOW^PXRMDATE
S TEXT(NFOUND)="End date is "_$$FMTE^XLFDT(EDATE,"5Z")
S DATA(NFOUND,"END DATE")=EDATE
S DATA(NFOUND,"VALUE")=$S(ELIG:"ELIGIBLE",1:"EXPIRED")
S DATA(NFOUND,"STATUS")=DATA(NFOUND,"VALUE")
Q
;
;===============
DISCHDT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
;This computed finding returns the service separation date.
;CF.VA-SERVICE SEPARATION DATES
N IND
D MSDATA(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT,1)
F IND=1:1:NFOUND S DATA(IND,"VALUE")=DATE(IND)
Q
;
;===============
ELIG(DFN,TEST,DATE,DATA,TEXT) ;
;This computed finding gets a list of the patient's eligibilities
;using ELIG^VADPT. The Computed Finding Parameter can be used to
;check for a particular eligibility.
;CF.VA-ELIGIBILITY
N DONE,CFPARAM,DEFTEXT,P1,P2,PARAM,SUB,SUB1,SUB2,VAEL,VAERR,VAL
S CFPARAM=TEST
I CFPARAM="" S TEST=0 Q
S PARAM=$P(CFPARAM,"|",1)
S DEFTEXT=$P(CFPARAM,"|",2)
S DATE=$$NOW^PXRMDATE
D ELIG^VADPT
;Initialize undefined VAEL elements in CFPARAM.
S (DONE,P1)=0
F Q:DONE D
. S P1=$F(PARAM,"VAEL(",P1)
. I P1=0 S DONE=1 Q
. S P2=$F(PARAM,")",P1)
. S SUB=$E(PARAM,P1,P2-2)
. I SUB'["," D Q
.. I '$D(VAEL(SUB)) S VAEL(SUB)=""
. S SUB1=$P(SUB,",",1),SUB2=$P(SUB,",",2)
. I '$D(VAEL(SUB1,SUB2)) S VAEL(SUB1,SUB2)=""
I $G(PXRMDEBG)=1 D
. K ^TMP("PXRMELIG",$J)
. M ^TMP("PXRMELIG",$J)=VAEL
I VAERR=1 S TEST=0 Q
S TEST=0
I @PARAM D
. I DEFTEXT'="" S TEXT=DEFTEXT_"\\"_" CFPARAM="_PARAM
. E S TEXT="CFPARAM="_PARAM
. S TEST=1
. S (DONE,P1)=0
. F Q:DONE D
.. S P1=$F(PARAM,"VAEL(",P1)
.. I P1=0 S DONE=1 Q
.. S P2=$F(PARAM,")",P1)
.. S SUB=$E(PARAM,P1,P2-2)
.. S VAL=$S(SUB'[",":VAEL(SUB),1:VAEL($P(SUB,",",1),$P(SUB,",",2)))
.. S TEXT=TEXT_"\\"_" VAEL("_SUB_")="_VAL
D KVAR^VADPT
Q
;
;===============
GETSVCD(DFN) ;Get the SVC^VADPT service data.
I $D(^TMP($J,"SVC",DFN)) Q
N VAERR,VAROOT
S VAROOT="^TMP($J,""SVC"",DFN)"
D SVC^VADPT
D KVAR^VADPT
Q
;
;===============
MSDATA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT,SEPDTR) ;This computed
;finding will return service branch information.
;CF.VA-SERVICE BRANCH.
;DBIA #5354
N ENTRYDTA,MSDATA,NEPS
D MSDATA^DGMSE(DFN,.NEPS,.ENTRYDTA,.MSDATA)
I NEPS=0 S NFOUND=0 Q
N BRANCH,DISTYPE,ENTRYDT,ENTRYDTO,IND,NOW
N SCOMP,SDIR,SEPDT,SEPDTC,SEPDTO
S NOW=$$NOW^PXRMDATE
S SDIR=$S(NGET>0:-1,1:1)
S NGET=$S(NGET<0:-NGET,1:NGET)
S NFOUND=0,ENTRYDT=""
F S ENTRYDT=$O(ENTRYDTA(ENTRYDT),SDIR) Q:(ENTRYDT="")!(NFOUND=NGET) D
. S IND=ENTRYDTA(ENTRYDT)
. S SEPDT=MSDATA(IND,"SEPARATION DATE")
.;Check for separation date required.
. I SEPDTR,SEPDT="" Q
. I SEPDTR,(SEPDT>EDT) Q
.;If there is no Separation Date use the evaluation date and time.
. S SEPDTC=$S(SEPDT'="":SEPDT,1:NOW)
. I $$OVERLAP^PXRMINDX(ENTRYDT,SEPDTC,BDT,EDT)'="O" Q
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=1
. S DATE(NFOUND)=MSDATA(IND,"DATE")
. S BRANCH=MSDATA(IND,"BRANCH")
. I BRANCH="" S BRANCH="<NO DATA>"
. S DATA(NFOUND,"BRANCH")=BRANCH
. S SCOMP=MSDATA(IND,"SERVICE COMPONENT")
. S SCOMP=$S(SCOMP="":"<NO DATA>",1:SCOMP)
. S DATA(NFOUND,"SERVICE COMPONENT")=SCOMP
. S DISTYPE=MSDATA(IND,"DISCHARGE TYPE")
. S DISTYPE=$S(DISTYPE="":"<NO DATA>",1:DISTYPE)
. S DATA(NFOUND,"DISCHARGE TYPE")=DISTYPE
. S ENTRYDTO=$$FMTE^XLFDT(ENTRYDT,"5Z")
. S SEPDTO=$S(SEPDT="":"<NO DATA>",1:$$FMTE^XLFDT(SEPDT,"5Z"))
. S TEXT(NFOUND)="Service from "_ENTRYDTO_" to "_SEPDTO_" in "_BRANCH_"; service component "_SCOMP_"; discharge "_DISTYPE_"."
Q
;
;===============
OEF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
;finding will return OEF service information in the date range
;specified by Beginning Date/Time and Ending Date/Time.
;VA-OEF SERVICE.
N FDATE,IND,SDIR,TDATE,TEMP
S NFOUND=0
S SDIR=$S(NGET<0:1,1:-1)
S NGET=$S(NGET<0:-NGET,1:NGET)
D GETSVCD(DFN)
I ^TMP($J,"SVC",DFN,12)=0 Q
S IND=""
F S IND=$O(^TMP($J,"SVC",DFN,12,IND)) Q:IND="" D
. S FDATE=$P(^TMP($J,"SVC",DFN,12,IND,2),U,1)
. I FDATE="" Q
. S TDATE=$P(^TMP($J,"SVC",DFN,12,IND,3),U,1)
. I $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O" Q
. S TEMP(FDATE,"TEST")=1
. S TEMP(FDATE,"DATA","LOCATION")=$P(^TMP($J,"SVC",DFN,12,IND,1),U,2)
. S TEMP(FDATE,"TEXT")="OEF service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_TEMP(FDATE,"DATA","LOCATION")
S FDATE=""
F S FDATE=$O(TEMP(FDATE),SDIR) Q:(FDATE="")!(NFOUND=NGET) D
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=TEMP(FDATE,"TEST"),DATE(NFOUND)=FDATE
. S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=TEMP(FDATE,"DATA","LOCATION")
. S TEXT(NFOUND)=TEMP(FDATE,"TEXT")
Q
;
;===============
OEIF(NGET,BDT,EDT,TGLIST,PARAM) ;List computed finding to build patient
;list based on OEF/OIF/UNK data.
;VA-OEF/OIF
N DA,DATE,DFN,FDATE,LOC,LOCATION,NFOUND,TDATE
K ^TMP($J,TGLIST)
;DBIA #5354
D OEIF^DGMSE(BDT,EDT,"OEIF")
S DATE=$$NOW^PXRMDATE
S NGET=$S(NGET<0:-NGET,1:NGET)
S LOCATION=$G(PARAM)
I LOCATION="" S LOCATION="ANY"
S DFN=""
F S DFN=$O(^TMP($J,"OEIF",DFN)) Q:DFN="" D
. S FDATE=""
. F S FDATE=$O(^TMP($J,"OEIF",DFN,FDATE)) Q:FDATE="" D
.. S TDATE=""
.. F S TDATE=$O(^TMP($J,"OEIF",DFN,FDATE,TDATE)) Q:TDATE="" D
... S LOC=""
... F S LOC=$O(^TMP($J,"OEIF",DFN,FDATE,TDATE,LOC)) Q:LOC="" D
.... S NFOUND=+$O(^TMP($J,TGLIST,DFN,""))
.... I NFOUND=NGET Q
.... I (LOCATION["ANY")!(LOCATION[LOC) D
..... S DA=""
..... F S DA=$O(^TMP($J,"OEIF",DFN,FDATE,TDATE,LOC,DA)) Q:DA="" D
...... S NFOUND=NFOUND+1
...... S ^TMP($J,TGLIST,DFN,NFOUND)=DFN_";"_DA_U_DATE_U_2_U_LOC_U_TDATE_";"_FDATE
K ^TMP($J,"OEIF")
Q
;
;===============
OIF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
;finding will return OIF service information in the date range
;specified by Beginning Date/Time and Ending Date/Time.
;VA-OIF SERVICE.
N FDATE,IND,SDIR,TDATE,TEMP
S NFOUND=0
S SDIR=$S(NGET<0:1,1:-1)
S NGET=$S(NGET<0:-NGET,1:NGET)
D GETSVCD(DFN)
I ^TMP($J,"SVC",DFN,11)=0 Q
S IND=""
F S IND=$O(^TMP($J,"SVC",DFN,11,IND)) Q:IND="" D
. S FDATE=$P(^TMP($J,"SVC",DFN,11,IND,2),U,1)
. I FDATE="" Q
. S TDATE=$P(^TMP($J,"SVC",DFN,11,IND,3),U,1)
. I $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O" Q
. S TEMP(FDATE,"TEST")=1
. S TEMP(FDATE,"DATA","LOCATION")=$P(^TMP($J,"SVC",DFN,11,IND,1),U,2)
. S TEMP(FDATE,"TEXT")="OIF service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_TEMP(FDATE,"DATA","LOCATION")
S FDATE=""
F S FDATE=$O(TEMP(FDATE),SDIR) Q:(FDATE="")!(NFOUND=NGET) D
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=TEMP(FDATE,"TEST"),DATE(NFOUND)=FDATE
. S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=TEMP(FDATE,"DATA","LOCATION")
. S TEXT(NFOUND)=TEMP(FDATE,"TEXT")
Q
;
;===============
PHEART(DFN,TEST,DATE,VALUE,TEXT) ;Single value computed finding for
;purple heart data. VA-PURPLE HEART.
N CV,EDATE,ELIG,RESULT
D GETSVCD(DFN)
S TEST=^TMP($J,"SVC",DFN,9)
I 'TEST Q
S DATE=$$NOW^PXRMDATE
S VALUE=""
S TEXT="Patient is a Purple Heart recipient."
Q
;
;===============
POW(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
;finding will be true if the patient was a POW in the date range
;specified by Beginning Date/Time and Ending Date/Time.
;VA-POW.
N FDATE,TDATE
S NFOUND=0
D GETSVCD(DFN)
S TEST=^TMP($J,"SVC",DFN,4)
I 'TEST Q
S FDATE=$P(^TMP($J,"SVC",DFN,4,1),U,1)
S TDATE=$P(^TMP($J,"SVC",DFN,4,2),U,1)
I $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O" S TEST=0 Q
S NFOUND=1
S TEST(NFOUND)=1,DATE(NFOUND)=FDATE
S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=$P(^TMP($J,"SVC",DFN,4,3),U,2)
S TEXT(NFOUND)="Patient was a POW from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_DATA(NFOUND,"LOCATION")
Q
;
;===============
RADEXP(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;;This computed
;finding will be true if the radiation exposure registration
;date is in the date range specified by Beginning Date/Time
;and Ending Date/Time. DVA-RADIATION EXPOSURE.
N RDATE
S NFOUND=0
D GETSVCD(DFN)
S TEST=^TMP($J,"SVC",DFN,3)
I 'TEST Q
S RDATE=$P(^TMP($J,"SVC",DFN,3,1),U,1)
I (RDATE<BDT)!(RDATE>EDT) S TEST=0 Q
S NFOUND=1
S TEST(NFOUND)=1,DATE(NFOUND)=RDATE
S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"EXPOSURE METHOD"))=$P(^TMP($J,"SVC",DFN,3,2),U,2)
S TEXT(NFOUND)="Radiation exposure registration date: "_$$FMTE^XLFDT(RDATE,"5Z")_"; exposure method: "_DATA(NFOUND,"EXPOSURE METHOD")
Q
;
;===============
SBRANCH(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
;finding will return service branch information.
;CF.VA-SERVICE BRANCH.
N IND
D MSDATA(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT,0)
F IND=1:1:NFOUND S DATA(IND,"VALUE")=DATA(IND,"BRANCH")
Q
;
;===============
UNKOEIF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
;finding will return unknown OEF/OIF service information in the date
;range specified by Beginning Date/Time and Ending Date/Time.
;VA-UNKNOWN OEF/OIF SERVICE.
N FDATE,IND,SDIR,TDATE,TEMP
S NFOUND=0
S SDIR=$S(NGET<0:1,1:-1)
S NGET=$S(NGET<0:-NGET,1:NGET)
D GETSVCD(DFN)
I ^TMP($J,"SVC",DFN,13)=0 Q
S IND=""
F S IND=$O(^TMP($J,"SVC",DFN,13,IND)) Q:IND="" D
. S FDATE=$P(^TMP($J,"SVC",DFN,13,IND,2),U,1)
. I FDATE="" Q
. S TDATE=$P(^TMP($J,"SVC",DFN,13,IND,3),U,1)
. I $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O" Q
. S TEMP(FDATE,"TEST")=1
. S TEMP(FDATE,"DATA","LOCATION")=$P(^TMP($J,"SVC",DFN,13,IND,1),U,2)
. S TEMP(FDATE,"TEXT")="OEF/OIF service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_TEMP(FDATE,"DATA","LOCATION")
S FDATE=""
F S FDATE=$O(TEMP(FDATE),SDIR) Q:(FDATE="")!(NFOUND=NGET) D
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=TEMP(FDATE,"TEST"),DATE(NFOUND)=FDATE
. S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=TEMP(FDATE,"DATA","LOCATION")
. S TEXT(NFOUND)=TEMP(FDATE,"TEXT")
Q
;
;===============
VETERAN(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding for checking if a
;patient is a veteran. VA-VETERAN.
N VAEL
S DATE=$$NOW^PXRMDATE
D ELIG^VADPT
S TEST=VAEL(4)
S VALUE=""
D KVAR^VADPT
Q
;
;===============
VIET(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed will be
;true if Vietnam service in the date range specified by BDT and EDT
;is found. Note even though it is a multi structure it can only
;return one occurrence. VA-VIETNAM SERVICE.
N FDATE,TDATE
S NFOUND=0
D GETSVCD(DFN)
S TEST=^TMP($J,"SVC",DFN,1)
I 'TEST Q
S FDATE=$P(^TMP($J,"SVC",DFN,1,1),U,1)
S TDATE=$P(^TMP($J,"SVC",DFN,1,2),U,1)
I $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O" S TEST=0 Q
S NFOUND=1
S TEST(NFOUND)=1,DATE(NFOUND)=FDATE
S TEXT(NFOUND)="Vietnam service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMMSER 13267 printed Apr 09, 2024@20:53:49 Page 2
PXRMMSER ;SLC/PKR,AJB - Computed findings for military service information. ;12/17/2019
+1 ;;2.0;CLINICAL REMINDERS;**11,12,21,24,26,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;===============
AORANGE(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
+1 ;finding will be true if the agent orange exposure registration
+2 ;date is in the date range specified by Beginning Date/Time
+3 ;and Ending Date/Time. VA-AGENT ORANGE EXPOSURE.
+4 NEW RDATE
+5 SET NFOUND=0
+6 DO GETSVCD(DFN)
+7 SET TEST=^TMP($JOB,"SVC",DFN,2)
+8 IF 'TEST
QUIT
+9 SET RDATE=+$PIECE(^TMP($JOB,"SVC",DFN,2,1),U,1)
+10 IF (RDATE=0)!(RDATE<BDT)!(RDATE>EDT)
SET TEST=0
QUIT
+11 SET NFOUND=1
+12 SET TEST(NFOUND)=1
SET DATE(NFOUND)=RDATE
+13 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=$PIECE(^TMP($JOB,"SVC",DFN,2,5),U,2)
+14 SET TEXT(NFOUND)="Agent orange exposure registration date: "_$$FMTE^XLFDT(RDATE,"5Z")_"; location: "_DATA(NFOUND,"LOCATION")
+15 QUIT
+16 ;
+17 ;===============
COMBAT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
+1 ;finding will be true if combat service is found in the
+2 ;date range the date range specified by Beginning Date/Time
+3 ;and Ending Date/Time. VA-COMBAT SERVICE.
+4 NEW FDATE,TDATE
+5 SET NFOUND=0
+6 DO GETSVCD(DFN)
+7 SET TEST=^TMP($JOB,"SVC",DFN,5)
+8 IF 'TEST
QUIT
+9 SET FDATE=$PIECE(^TMP($JOB,"SVC",DFN,5,1),U,1)
+10 SET TDATE=$PIECE(^TMP($JOB,"SVC",DFN,5,2),U,1)
+11 IF $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O"
SET TEST=0
QUIT
+12 SET NFOUND=1
+13 SET TEST(NFOUND)=1
SET DATE(NFOUND)=FDATE
+14 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=$PIECE(^TMP($JOB,"SVC",DFN,5,3),U,2)
+15 SET TEXT(NFOUND)="Combat service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_DATA(NFOUND,"LOCATION")
+16 QUIT
+17 ;
+18 ;===============
CVELIG(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;combat vet eligiblity data. VA-COMBAT VET ELIGIBILITY.
+2 NEW CV,EDATE,ELIG,RESULT
+3 ;DBIA #4156
+4 SET RESULT=$$CVEDT^DGCV(DFN,$$NOW^PXRMDATE)
+5 ;RESULT=(1,0,-1)^End Date (if populated, otherwise null)^CV
+6 ; (piece 1) 1 - qualifies as a CV
+7 ; 0 - does not qualify as a CV
+8 ; -1 - bad DFN or date
+9 ; (piece 3) 1 - vet was eligible on date specified (or DT)
+10 ; 0 - vet was not eligible on date specified (or DT)
+11 SET CV=$PIECE(RESULT,U,1)
SET EDATE=$PIECE(RESULT,U,2)
SET ELIG=$PIECE(RESULT,U,3)
+12 IF 'CV
SET NFOUND=0
QUIT
+13 SET NFOUND=1
+14 SET TEST(NFOUND)=CV
SET DATE(NFOUND)=$$NOW^PXRMDATE
+15 SET TEXT(NFOUND)="End date is "_$$FMTE^XLFDT(EDATE,"5Z")
+16 SET DATA(NFOUND,"END DATE")=EDATE
+17 SET DATA(NFOUND,"VALUE")=$SELECT(ELIG:"ELIGIBLE",1:"EXPIRED")
+18 SET DATA(NFOUND,"STATUS")=DATA(NFOUND,"VALUE")
+19 QUIT
+20 ;
+21 ;===============
DISCHDT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
+1 ;This computed finding returns the service separation date.
+2 ;CF.VA-SERVICE SEPARATION DATES
+3 NEW IND
+4 DO MSDATA(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT,1)
+5 FOR IND=1:1:NFOUND
SET DATA(IND,"VALUE")=DATE(IND)
+6 QUIT
+7 ;
+8 ;===============
ELIG(DFN,TEST,DATE,DATA,TEXT) ;
+1 ;This computed finding gets a list of the patient's eligibilities
+2 ;using ELIG^VADPT. The Computed Finding Parameter can be used to
+3 ;check for a particular eligibility.
+4 ;CF.VA-ELIGIBILITY
+5 NEW DONE,CFPARAM,DEFTEXT,P1,P2,PARAM,SUB,SUB1,SUB2,VAEL,VAERR,VAL
+6 SET CFPARAM=TEST
+7 IF CFPARAM=""
SET TEST=0
QUIT
+8 SET PARAM=$PIECE(CFPARAM,"|",1)
+9 SET DEFTEXT=$PIECE(CFPARAM,"|",2)
+10 SET DATE=$$NOW^PXRMDATE
+11 DO ELIG^VADPT
+12 ;Initialize undefined VAEL elements in CFPARAM.
+13 SET (DONE,P1)=0
+14 FOR
if DONE
QUIT
Begin DoDot:1
+15 SET P1=$FIND(PARAM,"VAEL(",P1)
+16 IF P1=0
SET DONE=1
QUIT
+17 SET P2=$FIND(PARAM,")",P1)
+18 SET SUB=$EXTRACT(PARAM,P1,P2-2)
+19 IF SUB'[","
Begin DoDot:2
+20 IF '$DATA(VAEL(SUB))
SET VAEL(SUB)=""
End DoDot:2
QUIT
+21 SET SUB1=$PIECE(SUB,",",1)
SET SUB2=$PIECE(SUB,",",2)
+22 IF '$DATA(VAEL(SUB1,SUB2))
SET VAEL(SUB1,SUB2)=""
End DoDot:1
+23 IF $GET(PXRMDEBG)=1
Begin DoDot:1
+24 KILL ^TMP("PXRMELIG",$JOB)
+25 MERGE ^TMP("PXRMELIG",$JOB)=VAEL
End DoDot:1
+26 IF VAERR=1
SET TEST=0
QUIT
+27 SET TEST=0
+28 IF @PARAM
Begin DoDot:1
+29 IF DEFTEXT'=""
SET TEXT=DEFTEXT_"\\"_" CFPARAM="_PARAM
+30 IF '$TEST
SET TEXT="CFPARAM="_PARAM
+31 SET TEST=1
+32 SET (DONE,P1)=0
+33 FOR
if DONE
QUIT
Begin DoDot:2
+34 SET P1=$FIND(PARAM,"VAEL(",P1)
+35 IF P1=0
SET DONE=1
QUIT
+36 SET P2=$FIND(PARAM,")",P1)
+37 SET SUB=$EXTRACT(PARAM,P1,P2-2)
+38 SET VAL=$SELECT(SUB'[",":VAEL(SUB),1:VAEL($PIECE(SUB,",",1),$PIECE(SUB,",",2)))
+39 SET TEXT=TEXT_"\\"_" VAEL("_SUB_")="_VAL
End DoDot:2
End DoDot:1
+40 DO KVAR^VADPT
+41 QUIT
+42 ;
+43 ;===============
GETSVCD(DFN) ;Get the SVC^VADPT service data.
+1 IF $DATA(^TMP($JOB,"SVC",DFN))
QUIT
+2 NEW VAERR,VAROOT
+3 SET VAROOT="^TMP($J,""SVC"",DFN)"
+4 DO SVC^VADPT
+5 DO KVAR^VADPT
+6 QUIT
+7 ;
+8 ;===============
MSDATA(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT,SEPDTR) ;This computed
+1 ;finding will return service branch information.
+2 ;CF.VA-SERVICE BRANCH.
+3 ;DBIA #5354
+4 NEW ENTRYDTA,MSDATA,NEPS
+5 DO MSDATA^DGMSE(DFN,.NEPS,.ENTRYDTA,.MSDATA)
+6 IF NEPS=0
SET NFOUND=0
QUIT
+7 NEW BRANCH,DISTYPE,ENTRYDT,ENTRYDTO,IND,NOW
+8 NEW SCOMP,SDIR,SEPDT,SEPDTC,SEPDTO
+9 SET NOW=$$NOW^PXRMDATE
+10 SET SDIR=$SELECT(NGET>0:-1,1:1)
+11 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+12 SET NFOUND=0
SET ENTRYDT=""
+13 FOR
SET ENTRYDT=$ORDER(ENTRYDTA(ENTRYDT),SDIR)
if (ENTRYDT="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+14 SET IND=ENTRYDTA(ENTRYDT)
+15 SET SEPDT=MSDATA(IND,"SEPARATION DATE")
+16 ;Check for separation date required.
+17 IF SEPDTR
IF SEPDT=""
QUIT
+18 IF SEPDTR
IF (SEPDT>EDT)
QUIT
+19 ;If there is no Separation Date use the evaluation date and time.
+20 SET SEPDTC=$SELECT(SEPDT'="":SEPDT,1:NOW)
+21 IF $$OVERLAP^PXRMINDX(ENTRYDT,SEPDTC,BDT,EDT)'="O"
QUIT
+22 SET NFOUND=NFOUND+1
+23 SET TEST(NFOUND)=1
+24 SET DATE(NFOUND)=MSDATA(IND,"DATE")
+25 SET BRANCH=MSDATA(IND,"BRANCH")
+26 IF BRANCH=""
SET BRANCH="<NO DATA>"
+27 SET DATA(NFOUND,"BRANCH")=BRANCH
+28 SET SCOMP=MSDATA(IND,"SERVICE COMPONENT")
+29 SET SCOMP=$SELECT(SCOMP="":"<NO DATA>",1:SCOMP)
+30 SET DATA(NFOUND,"SERVICE COMPONENT")=SCOMP
+31 SET DISTYPE=MSDATA(IND,"DISCHARGE TYPE")
+32 SET DISTYPE=$SELECT(DISTYPE="":"<NO DATA>",1:DISTYPE)
+33 SET DATA(NFOUND,"DISCHARGE TYPE")=DISTYPE
+34 SET ENTRYDTO=$$FMTE^XLFDT(ENTRYDT,"5Z")
+35 SET SEPDTO=$SELECT(SEPDT="":"<NO DATA>",1:$$FMTE^XLFDT(SEPDT,"5Z"))
+36 SET TEXT(NFOUND)="Service from "_ENTRYDTO_" to "_SEPDTO_" in "_BRANCH_"; service component "_SCOMP_"; discharge "_DISTYPE_"."
End DoDot:1
+37 QUIT
+38 ;
+39 ;===============
OEF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
+1 ;finding will return OEF service information in the date range
+2 ;specified by Beginning Date/Time and Ending Date/Time.
+3 ;VA-OEF SERVICE.
+4 NEW FDATE,IND,SDIR,TDATE,TEMP
+5 SET NFOUND=0
+6 SET SDIR=$SELECT(NGET<0:1,1:-1)
+7 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+8 DO GETSVCD(DFN)
+9 IF ^TMP($JOB,"SVC",DFN,12)=0
QUIT
+10 SET IND=""
+11 FOR
SET IND=$ORDER(^TMP($JOB,"SVC",DFN,12,IND))
if IND=""
QUIT
Begin DoDot:1
+12 SET FDATE=$PIECE(^TMP($JOB,"SVC",DFN,12,IND,2),U,1)
+13 IF FDATE=""
QUIT
+14 SET TDATE=$PIECE(^TMP($JOB,"SVC",DFN,12,IND,3),U,1)
+15 IF $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O"
QUIT
+16 SET TEMP(FDATE,"TEST")=1
+17 SET TEMP(FDATE,"DATA","LOCATION")=$PIECE(^TMP($JOB,"SVC",DFN,12,IND,1),U,2)
+18 SET TEMP(FDATE,"TEXT")="OEF service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_TEMP(FDATE,"DATA","LOCATION")
End DoDot:1
+19 SET FDATE=""
+20 FOR
SET FDATE=$ORDER(TEMP(FDATE),SDIR)
if (FDATE="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+21 SET NFOUND=NFOUND+1
+22 SET TEST(NFOUND)=TEMP(FDATE,"TEST")
SET DATE(NFOUND)=FDATE
+23 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=TEMP(FDATE,"DATA","LOCATION")
+24 SET TEXT(NFOUND)=TEMP(FDATE,"TEXT")
End DoDot:1
+25 QUIT
+26 ;
+27 ;===============
OEIF(NGET,BDT,EDT,TGLIST,PARAM) ;List computed finding to build patient
+1 ;list based on OEF/OIF/UNK data.
+2 ;VA-OEF/OIF
+3 NEW DA,DATE,DFN,FDATE,LOC,LOCATION,NFOUND,TDATE
+4 KILL ^TMP($JOB,TGLIST)
+5 ;DBIA #5354
+6 DO OEIF^DGMSE(BDT,EDT,"OEIF")
+7 SET DATE=$$NOW^PXRMDATE
+8 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+9 SET LOCATION=$GET(PARAM)
+10 IF LOCATION=""
SET LOCATION="ANY"
+11 SET DFN=""
+12 FOR
SET DFN=$ORDER(^TMP($JOB,"OEIF",DFN))
if DFN=""
QUIT
Begin DoDot:1
+13 SET FDATE=""
+14 FOR
SET FDATE=$ORDER(^TMP($JOB,"OEIF",DFN,FDATE))
if FDATE=""
QUIT
Begin DoDot:2
+15 SET TDATE=""
+16 FOR
SET TDATE=$ORDER(^TMP($JOB,"OEIF",DFN,FDATE,TDATE))
if TDATE=""
QUIT
Begin DoDot:3
+17 SET LOC=""
+18 FOR
SET LOC=$ORDER(^TMP($JOB,"OEIF",DFN,FDATE,TDATE,LOC))
if LOC=""
QUIT
Begin DoDot:4
+19 SET NFOUND=+$ORDER(^TMP($JOB,TGLIST,DFN,""))
+20 IF NFOUND=NGET
QUIT
+21 IF (LOCATION["ANY")!(LOCATION[LOC)
Begin DoDot:5
+22 SET DA=""
+23 FOR
SET DA=$ORDER(^TMP($JOB,"OEIF",DFN,FDATE,TDATE,LOC,DA))
if DA=""
QUIT
Begin DoDot:6
+24 SET NFOUND=NFOUND+1
+25 SET ^TMP($JOB,TGLIST,DFN,NFOUND)=DFN_";"_DA_U_DATE_U_2_U_LOC_U_TDATE_";"_FDATE
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 KILL ^TMP($JOB,"OEIF")
+27 QUIT
+28 ;
+29 ;===============
OIF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
+1 ;finding will return OIF service information in the date range
+2 ;specified by Beginning Date/Time and Ending Date/Time.
+3 ;VA-OIF SERVICE.
+4 NEW FDATE,IND,SDIR,TDATE,TEMP
+5 SET NFOUND=0
+6 SET SDIR=$SELECT(NGET<0:1,1:-1)
+7 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+8 DO GETSVCD(DFN)
+9 IF ^TMP($JOB,"SVC",DFN,11)=0
QUIT
+10 SET IND=""
+11 FOR
SET IND=$ORDER(^TMP($JOB,"SVC",DFN,11,IND))
if IND=""
QUIT
Begin DoDot:1
+12 SET FDATE=$PIECE(^TMP($JOB,"SVC",DFN,11,IND,2),U,1)
+13 IF FDATE=""
QUIT
+14 SET TDATE=$PIECE(^TMP($JOB,"SVC",DFN,11,IND,3),U,1)
+15 IF $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O"
QUIT
+16 SET TEMP(FDATE,"TEST")=1
+17 SET TEMP(FDATE,"DATA","LOCATION")=$PIECE(^TMP($JOB,"SVC",DFN,11,IND,1),U,2)
+18 SET TEMP(FDATE,"TEXT")="OIF service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_TEMP(FDATE,"DATA","LOCATION")
End DoDot:1
+19 SET FDATE=""
+20 FOR
SET FDATE=$ORDER(TEMP(FDATE),SDIR)
if (FDATE="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+21 SET NFOUND=NFOUND+1
+22 SET TEST(NFOUND)=TEMP(FDATE,"TEST")
SET DATE(NFOUND)=FDATE
+23 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=TEMP(FDATE,"DATA","LOCATION")
+24 SET TEXT(NFOUND)=TEMP(FDATE,"TEXT")
End DoDot:1
+25 QUIT
+26 ;
+27 ;===============
PHEART(DFN,TEST,DATE,VALUE,TEXT) ;Single value computed finding for
+1 ;purple heart data. VA-PURPLE HEART.
+2 NEW CV,EDATE,ELIG,RESULT
+3 DO GETSVCD(DFN)
+4 SET TEST=^TMP($JOB,"SVC",DFN,9)
+5 IF 'TEST
QUIT
+6 SET DATE=$$NOW^PXRMDATE
+7 SET VALUE=""
+8 SET TEXT="Patient is a Purple Heart recipient."
+9 QUIT
+10 ;
+11 ;===============
POW(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
+1 ;finding will be true if the patient was a POW in the date range
+2 ;specified by Beginning Date/Time and Ending Date/Time.
+3 ;VA-POW.
+4 NEW FDATE,TDATE
+5 SET NFOUND=0
+6 DO GETSVCD(DFN)
+7 SET TEST=^TMP($JOB,"SVC",DFN,4)
+8 IF 'TEST
QUIT
+9 SET FDATE=$PIECE(^TMP($JOB,"SVC",DFN,4,1),U,1)
+10 SET TDATE=$PIECE(^TMP($JOB,"SVC",DFN,4,2),U,1)
+11 IF $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O"
SET TEST=0
QUIT
+12 SET NFOUND=1
+13 SET TEST(NFOUND)=1
SET DATE(NFOUND)=FDATE
+14 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=$PIECE(^TMP($JOB,"SVC",DFN,4,3),U,2)
+15 SET TEXT(NFOUND)="Patient was a POW from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_DATA(NFOUND,"LOCATION")
+16 QUIT
+17 ;
+18 ;===============
RADEXP(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;;This computed
+1 ;finding will be true if the radiation exposure registration
+2 ;date is in the date range specified by Beginning Date/Time
+3 ;and Ending Date/Time. DVA-RADIATION EXPOSURE.
+4 NEW RDATE
+5 SET NFOUND=0
+6 DO GETSVCD(DFN)
+7 SET TEST=^TMP($JOB,"SVC",DFN,3)
+8 IF 'TEST
QUIT
+9 SET RDATE=$PIECE(^TMP($JOB,"SVC",DFN,3,1),U,1)
+10 IF (RDATE<BDT)!(RDATE>EDT)
SET TEST=0
QUIT
+11 SET NFOUND=1
+12 SET TEST(NFOUND)=1
SET DATE(NFOUND)=RDATE
+13 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"EXPOSURE METHOD"))=$PIECE(^TMP($JOB,"SVC",DFN,3,2),U,2)
+14 SET TEXT(NFOUND)="Radiation exposure registration date: "_$$FMTE^XLFDT(RDATE,"5Z")_"; exposure method: "_DATA(NFOUND,"EXPOSURE METHOD")
+15 QUIT
+16 ;
+17 ;===============
SBRANCH(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
+1 ;finding will return service branch information.
+2 ;CF.VA-SERVICE BRANCH.
+3 NEW IND
+4 DO MSDATA(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT,0)
+5 FOR IND=1:1:NFOUND
SET DATA(IND,"VALUE")=DATA(IND,"BRANCH")
+6 QUIT
+7 ;
+8 ;===============
UNKOEIF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed
+1 ;finding will return unknown OEF/OIF service information in the date
+2 ;range specified by Beginning Date/Time and Ending Date/Time.
+3 ;VA-UNKNOWN OEF/OIF SERVICE.
+4 NEW FDATE,IND,SDIR,TDATE,TEMP
+5 SET NFOUND=0
+6 SET SDIR=$SELECT(NGET<0:1,1:-1)
+7 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+8 DO GETSVCD(DFN)
+9 IF ^TMP($JOB,"SVC",DFN,13)=0
QUIT
+10 SET IND=""
+11 FOR
SET IND=$ORDER(^TMP($JOB,"SVC",DFN,13,IND))
if IND=""
QUIT
Begin DoDot:1
+12 SET FDATE=$PIECE(^TMP($JOB,"SVC",DFN,13,IND,2),U,1)
+13 IF FDATE=""
QUIT
+14 SET TDATE=$PIECE(^TMP($JOB,"SVC",DFN,13,IND,3),U,1)
+15 IF $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O"
QUIT
+16 SET TEMP(FDATE,"TEST")=1
+17 SET TEMP(FDATE,"DATA","LOCATION")=$PIECE(^TMP($JOB,"SVC",DFN,13,IND,1),U,2)
+18 SET TEMP(FDATE,"TEXT")="OEF/OIF service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")_"; location: "_TEMP(FDATE,"DATA","LOCATION")
End DoDot:1
+19 SET FDATE=""
+20 FOR
SET FDATE=$ORDER(TEMP(FDATE),SDIR)
if (FDATE="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+21 SET NFOUND=NFOUND+1
+22 SET TEST(NFOUND)=TEMP(FDATE,"TEST")
SET DATE(NFOUND)=FDATE
+23 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"LOCATION"))=TEMP(FDATE,"DATA","LOCATION")
+24 SET TEXT(NFOUND)=TEMP(FDATE,"TEXT")
End DoDot:1
+25 QUIT
+26 ;
+27 ;===============
VETERAN(DFN,TEST,DATE,VALUE,TEXT) ;Computed finding for checking if a
+1 ;patient is a veteran. VA-VETERAN.
+2 NEW VAEL
+3 SET DATE=$$NOW^PXRMDATE
+4 DO ELIG^VADPT
+5 SET TEST=VAEL(4)
+6 SET VALUE=""
+7 DO KVAR^VADPT
+8 QUIT
+9 ;
+10 ;===============
VIET(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;This computed will be
+1 ;true if Vietnam service in the date range specified by BDT and EDT
+2 ;is found. Note even though it is a multi structure it can only
+3 ;return one occurrence. VA-VIETNAM SERVICE.
+4 NEW FDATE,TDATE
+5 SET NFOUND=0
+6 DO GETSVCD(DFN)
+7 SET TEST=^TMP($JOB,"SVC",DFN,1)
+8 IF 'TEST
QUIT
+9 SET FDATE=$PIECE(^TMP($JOB,"SVC",DFN,1,1),U,1)
+10 SET TDATE=$PIECE(^TMP($JOB,"SVC",DFN,1,2),U,1)
+11 IF $$OVERLAP^PXRMINDX(FDATE,TDATE,BDT,EDT)'="O"
SET TEST=0
QUIT
+12 SET NFOUND=1
+13 SET TEST(NFOUND)=1
SET DATE(NFOUND)=FDATE
+14 SET TEXT(NFOUND)="Vietnam service from "_$$FMTE^XLFDT(FDATE,"5Z")_" to "_$$FMTE^XLFDT(TDATE,"5Z")
+15 QUIT
+16 ;
