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