Routine: DGRRPSEE

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)

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  Feb 19, 2025@00:23:52                                                                                                                                                                                                    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

DGRRPSEE.m