| [613] | 1 | SDWLSC ;IOFO BAY PINES/DMR - WAITING LIST-RATED DISABILITY ;09/02/2004 2:10 PM
|
|---|
| 2 | ;;5.3;scheduling;**394,417**;SEP 02 2004
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;***********************************************************************************************************
|
|---|
| 6 | ; CHANGE LOG
|
|---|
| 7 | ;
|
|---|
| 8 | ; DATE PATCH DESCRIPTION
|
|---|
| 9 | ; ---- ----- -----------
|
|---|
| 10 | ; 12/09/2005 SD*5.3*394 New Routine for SC disabilities prompt
|
|---|
| 11 | ;
|
|---|
| 12 | ;IA Agreements:
|
|---|
| 13 | ;
|
|---|
| 14 | ;DBIA - 1476 For reference to PRIMARY ELIG. ^DPT(IEN,.372).
|
|---|
| 15 | ;DBIA - 427 For reference to ^DIC(8).
|
|---|
| 16 | ;
|
|---|
| 17 | ;Variable: SDWLNSC killed in routine SDWLE113 - Routine SDWLSC called from SDWLE111.
|
|---|
| 18 | ; SDWLDFN NOT killed - referenced only.
|
|---|
| 19 | ;
|
|---|
| 20 | ;09/23/2006 Patch SD*5.3*417 Upper/Lower case usage.
|
|---|
| 21 | ;
|
|---|
| 22 | D 2^VADPT S SDWLNSC=0
|
|---|
| 23 | Q:'$D(SDWLDFN)
|
|---|
| 24 | Q:$$GET1^DIQ(2,SDWLDFN_",",.301,"E")'="YES"
|
|---|
| 25 | Q:$P(VAEL(1),"^",2)'["50%"
|
|---|
| 26 | S SDWLNSC=$P($G(^SDWL(409.3,SDWLDA,"SC")),U,2)
|
|---|
| 27 | W !!,"PATIENT'S SERVICE CONNECTION AND RATED DISABILITIES:"
|
|---|
| 28 | IF $D(^DPT(SDWLDFN,.3)) D
|
|---|
| 29 | .W !,$S($P($G(^DPT(SDWLDFN,.3)),"^",1)="Y":"SC Percent: "_$P(^(.3),"^",2)_"%",1:"Service Connected: No")
|
|---|
| 30 | .W !,"Primary Eligibility Code: "_$P(VAEL(1),"^",2)
|
|---|
| 31 | ;Rated Disabilities
|
|---|
| 32 | N SDSER,SDRAT,SDPER,SDREC,NN,NUM,ANS S (NN,NUM)=0
|
|---|
| 33 | F S NN=$O(^DPT(SDWLDFN,.372,NN)) Q:'NN D
|
|---|
| 34 | .S SDREC=$G(^DPT(SDWLDFN,.372,NN,0)) IF SDREC'="" D
|
|---|
| 35 | ..S SDRAT="" S NUM=$P($G(SDREC),"^",1) IF NUM>0 S SDRAT=$$GET1^DIQ(31,NUM_",",.01)
|
|---|
| 36 | ..S SDSER="" S SDSER=$S($P(SDREC,"^",3)="1":"SC",1:"NSC")
|
|---|
| 37 | ..W !," "_SDRAT_" ("_SDSER_" - "_$P(SDREC,"^",2)_"%)"
|
|---|
| 38 | ..Q
|
|---|
| 39 | W !
|
|---|
| 40 | N SDSCFLD,SDELIG S SDSCFLD=0
|
|---|
| 41 | S SDELIG=$$GET1^DIQ(2,SDWLDFN_",",.301,"E")
|
|---|
| 42 | IF $P(VAEL(1),U,2)="" W !,"'PRIMARY ELIGIBILITY CODE' field is blank please update patient record." S SDSCFLG=1
|
|---|
| 43 | IF SDELIG="YES",($P(VAEL(3),"^",2)<50),($P(VAEL(1),"^",2)'="SC LESS THAN 50%") D
|
|---|
| 44 | .W !,"The 'SC Percent','Service Connected' and 'Primary Eligibility Codes' are OUT OF SYNC, Please CORRECT the problem." S SDSCFLD=1
|
|---|
| 45 | IF SDELIG="YES",($P(VAEL(3),"^",2)>49),($P(VAEL(1),"^",2)'="SERVICE CONNECTED 50% to 100%") D
|
|---|
| 46 | .W !,"The 'SC Percent','Service Connected' and 'Primary Eligibility Codes' are OUT OF SYNC, Please CORRECT the problem." S SDSCFLD=1
|
|---|
| 47 | IF $P($G(^DPT(SDWLDFN,.372,0)),"^",4)<1 W !,"NO SERVICE CONNECTED DISABILITIES LISTED" W !
|
|---|
| 48 | D SBR
|
|---|
| 49 | K SDSCFLD Q
|
|---|
| 50 | SBR IF $D(SDWLEDIT) Q
|
|---|
| 51 | S ANS="" N X
|
|---|
| 52 | S X=$$GET1^DIQ(2,SDWLDFN_",",.302) IF X>49 S SDWLNSC=1 Q
|
|---|
| 53 | I SDSCFLD=1 Q
|
|---|
| 54 | SBR0 S DIR("B")="NO",DIR("A")="IS THIS APPOINTMENT FOR A SERVICE CONNECTED CONDITION? (Y OR N):",DIR(0)="Y^AO" D ^DIR S ANS=$S(Y=1:"Y",1:"N")
|
|---|
| 55 | I ANS'="Y"&(ANS'="N") W !,*7,"ENTER (Y or N) PLEASE!" G SBR
|
|---|
| 56 | I ANS["Y" S SDWLNSC=1
|
|---|
| 57 | Q
|
|---|
