247 lines
8.9 KiB
Mathematica
247 lines
8.9 KiB
Mathematica
DGRRPSEE ; ALB/SGG - rtnDGRR PatientServices Enrollment and Eligibility ;09/30/03 ; Compiled November 24, 2003 11:54:30
|
|
;;5.3;Registration;**557**;Aug 13, 1993
|
|
;
|
|
;
|
|
DOC ;<DataSet Name='EnrollmentEligibility'
|
|
;
|
|
;.04 ENROLLMENT STATUS (RP27.15'IX), [0;4]
|
|
; 27.01 CURRENT ENROLLMENT (P27.11'I), [ENR;1]
|
|
; .04 ENROLLMENT STATUS (RP27.15'IX), [0;4]
|
|
; .01 NAME (RF), [0;1]
|
|
;
|
|
;.07 ENROLLMENT PRIORITY (SXI), [0;7]
|
|
;
|
|
;.3721 RATED DISABILITIES (VA) (Multiple-2.04), [.372;0]
|
|
; .01 RATED DISABILITIES (VA) (MP31'X), [0;1]
|
|
; 2 DISABILITY % (RNJ3,0X), [0;2]
|
|
; 3 SERVICE CONNECTED (SX), [0;3]
|
|
; '0' FOR NO;
|
|
; '1' FOR YES;
|
|
;
|
|
;361 PATIENT ELIGIBILITIES (Multiple-2.0361), [E;0]
|
|
; .01 ELIGIBILITY (M*P8'X), [0;1] MAS ELIGIBILITY CODE (R*P8.1'), [0;9]
|
|
; .03 LONG ID (FX), [0;3]
|
|
; .04 SHORT ID (F), [0;4]
|
|
;
|
|
;.14 CURRENT MEANS TEST STATUS (P408.32'I), [0;14]
|
|
; .01 NAME (RFI), [0;1]
|
|
;
|
|
;.152 INELIGIBLE DATE (DX), [.15;2]
|
|
;.301 SERVICE CONNECTED? (RSXa), [.3;1]
|
|
;.302 SERVICE CONNECTED PERCENTAGE (NJ3,0Xa), [.3;2]
|
|
;.305 UNEMPLOYABLE (S), [.3;5]
|
|
;.307 INELIGIBLE REASON (FX), [.3;7]
|
|
;.313 CLAIM NUMBER (FXO), [.31;3]
|
|
;.323 PERIOD OF SERVICE (*P21'Xa), [.32;3]
|
|
;.361 PRIMARY ELIGIBILITY CODE (*P8'Xa), [.36;1] MAS ELIGIBILITY CODE (R*P8.1'), [0;9]
|
|
;27.11 .12 ENROLLMENT SUBGROUP (S), [0;12]
|
|
;
|
|
;.3611 ELIGIBILITY STATUS (SX), [.361;1]
|
|
; 'P' FOR PENDING VERIFICATION;
|
|
; 'R' FOR PENDING RE-VERIFICATION;
|
|
; 'V' FOR PENDING VERIFICATION;
|
|
;
|
|
;391 TYPE (RP391'a), [TYPE;1]
|
|
;1901 VETERAN (Y/N)? (RSXa), [VET;1]
|
|
;.32102 AGENT ORANGE EXPOS. INDICATED? (RSX), [.321;2]
|
|
;.32103 RADIATION EXPOSURE INDICATED? (RSX), [.321;3]
|
|
;.322013 ENVIRONMENTAL CONTAMINANTS? (RSX), [.322;13]
|
|
;.5291 COMBAT SERVICE INDICATED? (RSX) [.52;11]
|
|
; MILITARY SEXUAL TRAUMA (MST) $$GETSTAT^DGMSTAPI
|
|
; HEAD/NECK CANCER (CNV) $$GETCUR^DGNTAPI
|
|
;57.4 SPINAL CORD INJURY (S), [57;4]
|
|
;
|
|
GETPSARY(PSARRAY) ;
|
|
NEW CNT,DGAO,DGIR,DGENV,DGCS,DGHNC,DGMST
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='EnrollmentEligibility'"
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EnrollmentDate^"_$$ENRLDATE()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EnrollmentStatus^"_$$ENRLSTAT()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EnrollmentPriority^"_$$ENRLPRIO()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EnrollmentSubgroup^"_$$ENRLSUBG()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CurrentMeansTestStatus^"_$$CMEANTST()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^IneligibleDate^"_$$INELDATE()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ServiceConnected^"_$$SERVCONC()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ServiceConnectedPercentage^"_$$SERVCPER()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Unemployable^"_$$UNEMPLOY()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^IneligibleReason^"_$$INELIGRS()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ClaimNumber^"_$$CLAIMNUM()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PeriodOfService^"_$$PEROFSRV()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PrimaryEligibilityCode^"_$$ELIGPRIM()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EligibilityStatus^"_$$ELIGSTAT()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Type^"_$$PATNTYPE()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Veteran^"_$$VETERAN()
|
|
D CLASS(PTID)
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^AgentOrangeExposure^"_$G(DGAO)
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^IonizingRadiationExposure^"_$G(DGIR)
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EnvironmentalContaminantExposure^"_$G(DGENV)
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CombatServiceIndicated^"_$G(DGCS)
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MilitarySexualTrauma^"_$G(DGMST)
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^HeadNeckCancer^"_$G(DGHNC)
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SpinalCordInjuryStatus^"_$$SPINALCI()
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)=">"
|
|
DO ELIGIBLE
|
|
DO DISABLED
|
|
SET CNT=$G(CNT)+1,PSARRAY(CNT)="</DataSet>"_"^^^1"
|
|
QUIT
|
|
;
|
|
;
|
|
ENRLDATE() ;
|
|
NEW DATA
|
|
SET DATA=$P($G(^DPT(PTID,"ENR")),"^",1)
|
|
IF DATA'="" SET DATA=$P($G(^DGEN(27.11,DATA,0)),"^",10)
|
|
QUIT DATA
|
|
;
|
|
ENRLSTAT() ;
|
|
NEW DATA
|
|
SET DATA=$P($G(^DPT(PTID,"ENR")),"^",1)
|
|
IF DATA'="" SET DATA=$P($G(^DGEN(27.11,DATA,0)),"^",4)
|
|
IF DATA'="" SET DATA=$P($G(^DGEN(27.15,DATA,0)),"^",1)
|
|
QUIT DATA
|
|
;
|
|
ENRLPRIO() ;
|
|
NEW DATA
|
|
SET DATA=$P($G(^DPT(PTID,"ENR")),"^",1)
|
|
IF DATA'="" SET DATA=$P($G(^DGEN(27.11,DATA,0)),"^",7)
|
|
SET DATA=$S(DATA=1:"GROUP 1",DATA=2:"GROUP 2",DATA=3:"GROUP 3",DATA=4:"GROUP 4",DATA=5:"GROUP 5",DATA=6:"GROUP 6",DATA=7:"GROUP 7",DATA=8:"GROUP 8",1:"")
|
|
QUIT DATA
|
|
;
|
|
ENRLSUBG() ;
|
|
NEW DATA
|
|
SET DATA=$P($G(^DPT(PTID,"ENR")),"^",1)
|
|
IF DATA'="" SET DATA=$P($G(^DGEN(27.11,DATA,0)),"^",12)
|
|
SET DATA=$S(DATA=1:"a",DATA=3:"c",DATA=5:"e",DATA=7:"g",1:"")
|
|
QUIT DATA
|
|
;
|
|
CMEANTST() ;
|
|
NEW DATA
|
|
SET DATA=$P(GLOB(0),"^",14)
|
|
IF DATA'="" SET DATA=$P($G(^DG(408.32,DATA,0)),"^",1)
|
|
QUIT DATA
|
|
;
|
|
INELDATE() ;
|
|
QUIT $P(GLOB(.15),"^",2)
|
|
;
|
|
SERVCONC() ;
|
|
NEW DATA
|
|
SET DATA=$P(GLOB(.3),"^",1)
|
|
SET DATA=$S(DATA="Y":"YES",DATA="N":"NO",1:"")
|
|
QUIT DATA
|
|
;
|
|
SERVCPER() ;
|
|
QUIT $P(GLOB(.3),"^",2)
|
|
;
|
|
UNEMPLOY() ;
|
|
N DATA
|
|
SET DATA=$P(GLOB(.3),"^",5)
|
|
SET DATA=$S(DATA="Y":"YES",DATA="N":"NO",1:"")
|
|
QUIT DATA
|
|
;
|
|
INELIGRS() ;
|
|
QUIT $P(GLOB(.3),"^",7)
|
|
;
|
|
CLAIMNUM() ;
|
|
QUIT $P(GLOB(.31),"^",3)
|
|
;
|
|
PEROFSRV() ;
|
|
NEW DATA
|
|
SET DATA=$P(GLOB(.32),"^",3)
|
|
IF DATA'="" SET DATA=$P($G(^DIC(21,DATA,0)),"^",1)
|
|
QUIT DATA
|
|
;
|
|
ELIGPRIM() ;
|
|
NEW DATA
|
|
SET DATA=$P(GLOB(.36),"^",1)
|
|
IF DATA'="" SET DATA=$P($G(^DIC(8,DATA,0)),"^",9)
|
|
IF DATA'="" SET DATA=$P($G(^DIC(8.1,DATA,0)),"^",1)
|
|
QUIT DATA
|
|
;
|
|
ELIGSTAT() ;
|
|
NEW DATA
|
|
SET DATA=$P(GLOB(.361),"^",1)
|
|
SET DATA=$S(DATA="P":"PENDING VERIFICATION",DATA="R":"PENDING RE-VERIFICATION",DATA="V":"PENDING VERIFICATION",1:"")
|
|
QUIT DATA
|
|
;
|
|
PATNTYPE() ;
|
|
NEW DATA
|
|
SET DATA=$P($G(^DPT(PTID,"TYPE")),"^",1)
|
|
I DATA'="" SET DATA=$P($G(^DG(391,DATA,0)),"^",1)
|
|
QUIT DATA
|
|
;
|
|
VETERAN() ;
|
|
NEW DATA
|
|
SET DATA=$P($G(^DPT(PTID,"VET")),"^",1)
|
|
SET DATA=$S(DATA="Y":"YES",DATA="N":"NO",1:"")
|
|
QUIT DATA
|
|
;
|
|
CLASS(PTID) ;Get A/O, Ion. Rad., Env. Cont., Combat Svc, MST, HNC
|
|
I $G(PTID)="" Q
|
|
N DGARRY,DGERR,DGIENS,DGNTAPI
|
|
S DGIENS=$$IENS^DILF(PTID)
|
|
D GETS^DIQ(2,DGIENS,".32102;.32103;.322013;.5291","E","DGARRY","DGERR")
|
|
I '$D(DGERR) D
|
|
.S DGAO=$G(DGARRY(2,DGIENS,.32102,"E"))
|
|
.S DGIR=$G(DGARRY(2,DGIENS,.32103,"E"))
|
|
.S DGENV=$G(DGARRY(2,DGIENS,.322013,"E"))
|
|
.S DGCS=$G(DGARRY(2,DGIENS,.5291,"E"))
|
|
; Get MST information
|
|
S DGMST=$$GETSTAT^DGMSTAPI(PTID)
|
|
;MST Status (#3) field from MST History (#29.11) file
|
|
S DGMST=$P($G(DGMST),U,6)
|
|
; Get Head/Neck Cancer information
|
|
S DGNTAPI=$$GETCUR^DGNTAPI(PTID,"DGNTAPI")
|
|
; NTR Indicator (#.02) field from Nose and Throad Radium History (#28.11) file
|
|
S DGHNC=$P($G(DGNTAPI("IND")),U,2)
|
|
Q
|
|
;
|
|
SPINALCI() ;
|
|
NEW DATA
|
|
SET DATA=$P(GLOB(57),"^",4)
|
|
IF DATA=1 S DATA="PARAPLEGIA-TRAUMATIC"
|
|
IF DATA=2 S DATA="QUADRIPLEGIA-TRAUMATIC"
|
|
IF DATA=3 S DATA="PARAPLEGIA-NONTRAUMATIC"
|
|
IF DATA=4 S DATA="QUADRIPLEGIA-NONTRAUMATIC"
|
|
IF DATA="X" S DATA="NOT APPLICABLE"
|
|
QUIT DATA
|
|
;
|
|
DISABLED ;
|
|
NEW DABLECNT,ROWCNT,DABLERTD,DABLEPER,DABLECON
|
|
SET DABLECNT=0,ROWCNT=0
|
|
FOR SET DABLECNT=$O(^DPT(PTID,.372,DABLECNT)) QUIT:(DABLECNT<1) DO
|
|
.SET GLOB(.372)=$G(^DPT(PTID,.372,DABLECNT,0))
|
|
.SET DABLERTD=$P(GLOB(.372),"^",1)
|
|
.SET DABLERTD=$P($G(^DIC(31,+DABLERTD,0)),"^",1)
|
|
.Q:DABLERTD=""
|
|
.SET DABLEPER=$P(GLOB(.372),"^",2)
|
|
.SET DABLECON=$S($P(GLOB(.372),"^",3)=0:"NO",$P(GLOB(.372),"^",3)=1:"YES",1:"")
|
|
.IF +$L(DABLERTD_DABLEPER_DABLECON) DO
|
|
..SET ROWCNT=ROWCNT+1
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="<RatedDisability Row='"_ROWCNT_"'"
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Disability^"_DABLERTD_"^^DISABLED^"_ROWCNT
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Percent^"_DABLEPER_"^^DISABLED^"_ROWCNT
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Connected^"_DABLECON_"^^DISABLED^"_ROWCNT
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="></RatedDisability>"
|
|
IF ROWCNT=0 DO
|
|
.SET CNT=$G(CNT)+1,PSARRAY(CNT)="<RatedDisability Row='1' Disability='' Percent='' Connected=''></RatedDisability>"
|
|
QUIT
|
|
;
|
|
ELIGIBLE ;
|
|
NEW ELIGCNT,ROWCNT,ELIGIBLE,ELIGLONG,ELIGSHRT
|
|
SET ELIGCNT=0,ROWCNT=0
|
|
FOR SET ELIGCNT=$O(^DPT(PTID,"E",ELIGCNT)) QUIT:(ELIGCNT<1) DO
|
|
.SET GLOB("E")=$G(^DPT(PTID,"E",ELIGCNT,0))
|
|
.SET ELIGIBLE=$P(GLOB("E"),"^",1)
|
|
.IF ELIGIBLE'="" SET ELIGIBLE=$P($G(^DIC(8,ELIGIBLE,0)),"^",9)
|
|
.IF ELIGIBLE'="" SET ELIGIBLE=$P($G(^DIC(8.1,ELIGIBLE,0)),"^",1)
|
|
.SET ELIGLONG=$P(GLOB("E"),"^",3)
|
|
.SET ELIGSHRT=$P(GLOB("E"),"^",4)
|
|
.IF +$L(ELIGIBLE_ELIGLONG_ELIGSHRT) DO
|
|
..SET ROWCNT=ROWCNT+1
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="<PatientEligibility Row='"_ROWCNT_"'"
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Eligibility^"_ELIGIBLE_"^^ELIGIBLE^"_ROWCNT
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LongID^"_ELIGLONG_"^^ELIGIBLE^"_ROWCNT
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ShortID^"_ELIGSHRT_"^^ELIGIBLE^"_ROWCNT
|
|
..SET CNT=$G(CNT)+1,PSARRAY(CNT)="></PatientEligibility>"
|
|
IF ROWCNT=0 DO
|
|
.SET CNT=$G(CNT)+1,PSARRAY(CNT)="<PatientEligibility Row='1' Eligibility='' LongID='' ShortID=''></PatientEligibility>"
|
|
QUIT
|