| 1 | DGLOCK1 ;ALB/MRL - PATIENT FILE DATA EDIT CHECK ; 28 JUL 86
|
---|
| 2 | ;;5.3;Registration;**121,314**;Aug 13, 1993
|
---|
| 3 | AOD ;AO Delete
|
---|
| 4 | I $D(^DPT(DFN,.321)),$P(^(.321),U,2)="Y" W !?4,*7,"Can't delete as long as Agent Orange exposure is indicated." K X
|
---|
| 5 | Q
|
---|
| 6 | COMD ;Combat Delete
|
---|
| 7 | I $D(^DPT(DFN,.52)),$P(^(.52),U,11)="Y" W !?4,*7,"Can't delete as long as Combat Service is indicated." K X
|
---|
| 8 | Q
|
---|
| 9 | INED ;Ineligible Delete
|
---|
| 10 | I $D(^DPT(DFN,.15)),$P(^(.15),U,2)]"" W !?4,*7,"Can't delete this field as long as 'INELIGIBLE DATE' is on file." K X
|
---|
| 11 | Q
|
---|
| 12 | IRD ;ION Rad Delete
|
---|
| 13 | I $D(^DPT(DFN,.321)),$P(^(.321),U,3)="Y" W !?4,*7,"Can't delete as long as Ionizing Radiation exposure is indicated." K X
|
---|
| 14 | Q
|
---|
| 15 | POWD ;POW Delete
|
---|
| 16 | I $D(^DPT(DFN,.52)),$P(^(.52),U,5)="Y" W !?4,*7,"Still identified as former POW...Change status to delete." K X
|
---|
| 17 | Q
|
---|
| 18 | TADD ;Temp Add Delete
|
---|
| 19 | I $D(^DPT(DFN,.121)),$P(^(.121),U,9)="Y" W !?4,*7,"Answer NO to the 'WANT TO ENTER TEMPORARY ADDRESS' prompt, then delete." K X
|
---|
| 20 | Q
|
---|
| 21 | VND ;Viet Svc Delete
|
---|
| 22 | I $D(^DPT(DFN,.321)),$P(^(.321),U,1)="Y" W !?4,*7,"Can't delete as long as Vietnam Service is still indicated." K X
|
---|
| 23 | Q
|
---|
| 24 | SVDEL ;Panama, Grenada, Lebanon, Persian Gulf Svc Delete
|
---|
| 25 | ;DGX = piece position of corresponding service indicated? field
|
---|
| 26 | I $D(^DPT(DFN,.322)),$P(^(.322),U,DGX)="Y" W !?4,*7,"Can't delete as long as ",$S(DGX=1:"Lebanon",DGX=4:"Grenada",DGX=7:"Panama",1:"Persian Gulf")," is still indicated." K X
|
---|
| 27 | K DGX
|
---|
| 28 | Q
|
---|
| 29 | EC S DGEC=$S('$D(^DPT(DFN,.36)):"",$D(^DIC(8,+$P(^DPT(DFN,.36),U,1),0)):$P(^(0),U,9),1:"") I DGEC=5 W !?4,*7,"Eligibility Code is 'NSC'...Can't be YES." K X,DGEC Q
|
---|
| 30 | K DGEC Q
|
---|
| 31 | POS ;Screen
|
---|
| 32 | K DGEC D SV1^DGLOCK I $D(X) S DIC("S")="I '$P(^(0),""^"",8),$D(^DPT(DA,.36)),$D(^DIC(21,+Y,""E"",+$P(^(.36),U,1)))" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X D:'$D(X) POSH I $D(X),$D(^DIC(21,X,0)),$P(^(0),U,7)]"" D POS1 Q
|
---|
| 33 | Q
|
---|
| 34 | POS1 S XX=$P(^DIC(21,X,0),U,7) I $P(^DPT(DA,0),U,3)]"" I $P(^(0),U,3)'>XX!($D(^XUSEC("DG ELIGIBILITY",DUZ))) K XX Q
|
---|
| 35 | W !?5,*7,"Applicant is too young to have served in that period of service.",!?5,"See your supervisor if you require assistance." K X,XX Q
|
---|
| 36 | POSH S DGEC=$S('$D(^DPT(DFN,.36)):"",$D(^DIC(8,+$P(^(.36),U,1),0)):$P(^(0),U,1),1:"") W !?5,"Current Eligibility Code" W:DGEC]"" ": ",DGEC I DGEC']"" W " is not defined. Must be defined in order",!?5,"to enter a POS."
|
---|
| 37 | K DGEC Q
|
---|
| 38 | SC S DGSCON=$S('$D(^DPT(DFN,.3)):0,$P(^(.3),U,1)="Y":1,1:0) I 'DGSCON W !?4,*7,"Not possible, applicant is not service-connected." K X,DGSCON Q
|
---|
| 39 | K DGSCON Q
|
---|
| 40 | ;
|
---|
| 41 | ECD ;primary eligibility code input transform
|
---|
| 42 | ;
|
---|
| 43 | N DGNODE,DGPC,DGSER,DGVT,DGXX
|
---|
| 44 | S DGVT=$G(^DPT(DFN,"VET")),DGSER=$S('$D(^DPT(DFN,.3)):0,$P(^(.3),U,1)="Y":1,1:0)
|
---|
| 45 | I DGVT']"" K X W !?4,*7,"'VETERAN (Y/N)' prompt must be answered to select an Eligibility Code'" Q
|
---|
| 46 | S DIC("S")="I $P(^DIC(8,+Y,0),U,5)=DGVT,'$P(^(0),U,7)" I DGVT="N" G ECDS
|
---|
| 47 | I DGSER S DGPC=$S(+$P(^DPT(DFN,.3),U,2)>49:1,1:0),DGXX=$S(DGPC:1,1:3),DIC("S")=DIC("S")_",($P(^(0),U,9)="_DGXX_")" G ECDS ;sc only
|
---|
| 48 | I $P($G(^DPT(DFN,.52)),"^",5)="Y" S DIC("S")=DIC("S")_",($P(^(0),U,9)=18)" G ECDS ;pow only
|
---|
| 49 | S DGXX="^1^3^18^" ; no sc<50, sc 50-100, pow
|
---|
| 50 | I $P($G(^DPT(DFN,.53)),U)="Y" S DIC("S")=DIC("S")_",($P(^(0),U,9)=22)" G ECDS ;checks for PH Indicator
|
---|
| 51 | S DGXX=DGXX_"22^" ;adds PH to DGXX string
|
---|
| 52 | S DGNODE=$G(^DPT(DFN,.362))
|
---|
| 53 | I $P(DGNODE,"^",12)'="Y" S DGXX=DGXX_"2^"
|
---|
| 54 | I $P(DGNODE,"^",14)'="Y" S DGXX=DGXX_"4^"
|
---|
| 55 | I $P(DGNODE,"^",13)'="Y" S DGXX=DGXX_"15^"
|
---|
| 56 | F I=12:1:14 I $P(DGNODE,"^",I)="Y" S DGXX=DGXX_"5^"_$S(I'=14:"4^",1:"")
|
---|
| 57 | I $P($G(^DPT(DFN,0)),"^",3)>2200101 S DGXX=DGXX_"16^17^" ; WWI or mexican border only
|
---|
| 58 | S DIC("S")=DIC("S")_",("""_DGXX_"""'[(U_$P(^(0),U,9)_U))"
|
---|
| 59 | ECDS D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
|
---|
| 60 | ;
|
---|
| 61 | ;catastrophic disability can not be primary
|
---|
| 62 | I $G(X),$$NATNAME^DGENELA(X)="CATASTROPHICALLY DISABLED" K X Q
|
---|
| 63 | ;
|
---|
| 64 | Q
|
---|