source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRP7CC.m@ 1724

Last change on this file since 1724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1DGRP7CC ;BAJ,EG - REGISTRATION SCREEN 7/CROSS REFERENCE CLEANUP ;10/24/2006
2 ;;5.3;Registration;**657**;Aug 13, 1993;Build 19
3EN ; entry point
4 ;
5 ; Code to TRIGGER deletion of field data.
6 N DGENDA,DATA,VAL,ERROR,CNT,FIELD,X
7 S DGENDA=DA
8 I $$CHNGD(DFN) D
9 . ;need to kill this node or the deletes won't work...
10 . ;you get a message that patient is not a veteran
11 . K ^DPT(DFN,"VET")
12 . F CNT=1:1 S FIELD=$P($T(DATA+CNT),";;",3) Q:FIELD="QUIT" D
13 .. S VAL=$S(FIELD=.301:"N",1:"@")
14 .. S DATA(FIELD)=VAL
15 .. Q
16 . S X=$$UPD^DGENDBS(2,DGENDA,.DATA,.ERROR)
17 . ; delete Service Related Conditions if NON-Vet
18 . D DELSVC(DFN)
19 . ;remove service connected and compensation connected eligibilities
20 . S X=$$OELIG(DFN)
21 . S ^DPT(DFN,"VET")="N"
22 . Q
23 Q
24 ;
25 ;
26CHNGD(DFN) ; logic to determine if value has changed
27 N Y,X
28 ; if a new entry read the array
29 I '$D(^DPT(DFN,"VET")) D Q X
30 . S Y(1)=$C(59)_$P($G(^DD(2,1901,0)),U,3) S X=$P($P(Y(1),$C(59)_Y(0)_":",2),$C(59))="NO"
31 ;
32 ; else read the "VET" value
33 S Y(2)=$C(59)_$P($G(^DD(2,1901,0)),U,3),Y(1)=$S($D(^DPT(DFN,"VET")):^DPT(DFN,"VET"),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,1)_":",2),$C(59))="NO"
34 ;
35 ; Return 0 for VET, 1 for NON-Vet
36 Q X
37 ;
38DELSVC(DFN) ; Delete Service Connected Conditions
39 N DA,DIK
40 S DIK="^DPT("_DFN_",.373,"
41 S DA=0 F S DA=$O(^DPT(DFN,.373,DA)) Q:DA="" D ^DIK
42 Q
43 ;
44OELIG(DFN) ;remove sc codes from other eligibility
45 N DA,DIK,OLD,VAL,IEN,DE
46 S DIK="^DPT("_DFN_","_$C(34)_"E"_$C(34)_","
47 S DA=0 F S DA=$O(^DPT(DFN,"E",DA)) Q:DA="" D
48 . S IEN=$P($G(^DPT(DFN,"E",DA,0)),"^",1) I IEN="" Q
49 . S VAL=$P($G(^DIC(8,IEN,0)),"^",1)
50 . I $T(NVETNSC)'[(";"_VAL_";") Q
51 . S DA(1)=DFN
52 . D ^DIK
53 . Q
54 Q 1
55DATA ;These are the fields to be changed
56 ;;Receiving A&A;;.36205
57 ;;Amount of A&A;;.3621
58 ;;Receiving Housebound;;.36215
59 ;;Amount of Housebound;;.3622
60 ;;Receiving VA Pension;;.36235
61 ;;Service Connected;;.301
62 ;;Service Connected %-age;;.302
63 ;;SC Award Date;;.3012
64 ;;Eff. Date Combined SC% Eval;;.3014
65 ;;Rated Incompetent;;.293
66 ;;Date Ruled Incompetent (VA);;.291
67 ;;Date Ruled Incompetent (Civil);;.292
68 ;;VA Disability;;.3025
69 ;;Amount of VA Disability;;.303
70 ;;Amount of VA Pension;;.3624
71 ;;Total Check Amount;;.36295
72 ;;POW Indicated;;.525
73 ;;POW War;;.526
74 ;;POW Date From;;.527
75 ;;POW Date To;;.528
76 ;;Mil Disab Retirement;;.3602
77 ;;Discharge Due to Disab;;.3603
78 ;;QUIT;;QUIT
79 ;;
80NVETNSC ;;SC LESS THAN 50%;SERVICE CONNECTED 50% to 100%;NSC, VA PENSION;AID & ATTENDANCE;HOUSEBOUND;ALLIED VETERAN;
Note: See TracBrowser for help on using the repository browser.