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