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

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1DGDEP1 ;ALB/CAW,ERC List One Dependent/Edit Effective Dates ; 9/29/05 8:11am
2 ;;5.3;Registration;**45,60,624,653**;Aug 13, 1993;Build 2
3 ;
4LSTDEP(DGDEP) ;List Dependents
5 N DEP,CNT S CNT=0
6 F S CNT=$O(DGDEP(CNT)) Q:'CNT D ONE(CNT)
7 Q
8 ;
9ONE(CNT) ; List one dependent
10 ;
11 N DGLN S DGLN=1
12 ;
13 S X="",X=$$SETSTR^VALM1("DOB: ",X,5,5)
14 S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,4),X,10,14)
15 S X=$$SETSTR^VALM1("Sex: ",X,30,5)
16 S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,3),X,35,8)
17 S X=$$SETSTR^VALM1("SSN: ",X,52,5)
18 S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,5),X,57,14)
19 D SET(X)
20 ;
21 ;* Output Spouse' Maiden Name, if defined (DG*5.3*624)
22 S X=""
23 I $P($G(DGDEP(CNT)),U,2)="SPOUSE" DO
24 . N DGMNTEXT
25 . S X=$$SETSTR^VALM1("Maiden: ",X,2,8)
26 . S DGMNTEXT=$P($G(DGDEP(CNT,"MNADD")),U,1)
27 . S:DGMNTEXT]"" X=$$SETSTR^VALM1(DGMNTEXT,X,10,30)
28 . S:DGMNTEXT']"" X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
29 ;display PSSN Reason if SSN is a pseudo - DG*5.3*653
30 I $P($G(DGDEP(CNT)),U,2)'="SELF",($P(DGDEP(CNT),U,5)["P") D
31 . S X=$$SETSTR^VALM1("PSSN Reason: ",X,44,15)
32 . I $P(DGDEP(CNT),U,10)["Unk" S $P(DGDEP(CNT),U,10)="SSN Unkn/Follow-up Req"
33 . S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,10),X,57,22)
34 D SET(X)
35 S DEP=""
36 F S DEP=$O(DGDEP(CNT,DEP)) Q:DEP']"" D
37 .I DEP'="MNADD" DO
38 ..S X="",X=$$SETSTR^VALM1("Status: ",X,2,8)
39 ..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U,2),X,10,24)
40 ..S X=$$SETSTR^VALM1("Effective Date: ",X,41,15)
41 ..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U),X,57,20)
42 ..D SET(X)
43 ..I $P(DGDEP(CNT,DEP),U,3) D
44 ...S X="",X=$$SETSTR^VALM1("Filed by IVM: ",X,43,14)
45 ...S X=$$SETSTR^VALM1("Yes",X,57,20)
46 ...D SET(X)
47 ..D SET("")
48 S VALMCNT=DGLN-1
49 ;
50 S X=""
51 S X=$$SETSTR^VALM1("Address: ",X,1,9)
52 S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)="^^^^^") X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
53 S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,2),X,10,35)
54 S X=$$SETSTR^VALM1("Phone: ",X,50,7)
55 S:($P($G(DGDEP(CNT,"MNADD")),U,8)="") X=$$SETSTR^VALM1("UNANSWERED",X,57,10)
56 S:($P($G(DGDEP(CNT,"MNADD")),U,8)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,8),X,57,13)
57 D SET(X)
58 ;
59 ;* Output dependent address (DG*5.3*624)
60 I ($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") DO
61 .S X=""
62 .S:($P($G(DGDEP(CNT,"MNADD")),U,3)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,3),X,10,30)
63 .S:($P($G(DGDEP(CNT,"MNADD")),U,3)="") X=$$SETSTR^VALM1(" ",X,10,1)
64 .D SET(X)
65 .S X=""
66 .S:($P($G(DGDEP(CNT,"MNADD")),U,4)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,4),X,10,30)
67 .S:($P($G(DGDEP(CNT,"MNADD")),U,4)="") X=$$SETSTR^VALM1(" ",X,10,1)
68 .D SET(X)
69 .S X=""
70 .I ($P($G(DGDEP(CNT,"MNADD")),U,5)'="") DO
71 ..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,5),X,10,30)
72 ..S X=$$SETSTR^VALM1(",",X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+10),1)
73 .S:($P($G(DGDEP(CNT,"MNADD")),U,5)="") X=$$SETSTR^VALM1(" ",X,10,1)
74 .N STATVAL,ZIPPOS
75 .S STATVAL=""
76 .I ($P($G(DGDEP(CNT,"MNADD")),U,6)'="") DO
77 ..S STATVAL=$P(^DIC(5,$P($G(DGDEP(CNT,"MNADD")),U,6),0),"^",1)
78 ..S X=$$SETSTR^VALM1(STATVAL,X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+12),30)
79 .S:($P($G(DGDEP(CNT,"MNADD")),U,6)="") X=$$SETSTR^VALM1(" ",X,41,1)
80 .;;D SET(X)
81 .;;S X=""
82 .I ($P($G(DGDEP(CNT,"MNADD")),U,7)'="") DO
83 ..S ZIPPOS=($L($P($G(DGDEP(CNT,"MNADD")),U,5))+($L(STATVAL))+14)
84 ..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,7),X,ZIPPOS,10)
85 .S:($P($G(DGDEP(CNT,"MNADD")),U,7)="") X=$$SETSTR^VALM1(" ",X,20,1)
86 .D SET(X)
87 ;
88 S VALMCNT=DGLN-1
89 Q
90 ;
91SET(X) ;Set up array
92 S ^TMP("DGMTEP",$J,DGLN,0)=X
93 S DGLN=DGLN+1
94 Q
95 ;
96EXIT ;
97 K ^TMP("DGMTEP",$J)
98 Q
99 ;
100EN ; Effective Dates
101 S VALMBCK=""
102 I $D(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G ENQ
103 I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
104 D EDIT
105 I DGW=1 D I $G(DGERR) W !,"Cannot inactivate veteran" K DGERR G EN
106 .S DATE=$O(DGDEP(1,""))
107 .S ACTIVE=$P(DGDEP(1,DATE),U,2)
108 .I ACTIVE="Inactive" S DGERR=1
109ENQ S VALMBCK="R"
110 Q
111 ;
112EDIT ; Edit Effective Dates
113 ; values for DGFLG:
114 ; DGFLG = 1 IVM effective date
115 ;
116 N DA,DR,DIE,DIC,DATE,DGEDIT,DGEE,Y
117 S DGFLG=0,DGEDIT=1
118 S DGPR=$S($G(DGW):$P(DGDEP(DGW),U,20),1:$P(DGDEP,U,20))
119 S DIE="^DGPR(408.12,",DA=DGPR,DR="75"
120 S DR(2,408.1275)="I $P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,3) S Y=0,DGFLG=1;S:$P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,2)']"""" DIE(""NO^"")="""";.01;.02"
121 D ^DIE
122 I DGFLG W !!,"Cannot edit date added by IVM." H 2 G EDITQ
123 S DATE=0,DATE=$O(^DGPR(408.12,$P(DGDEP(DGW),U,20),"E",DATE))
124 I 'DATE W !!,"There has to be an effective date for this person." H 2 G EDIT
125EDITQ K DGDEP,DGFLG D INIT^DGDEP
126 K ^TMP("DGMTEP",$J) D ONE(DGW)
127 Q
128 ;
129DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
130 N DGFILE,X1
131 S DGFILE=$P($G(^DGPR(408.12,DA,0)),U,3),X1=$P(DGFILE,";"),DGFILE=$S(DGFILE["DGPR":"^DGPR(408.13,",1:"^DPT(")
132 I X<$P($G(@(DGFILE_X1_",0)")),U,3) D
133 . W !," <<EFFECTIVE DATE may not precede Date Of Birth>>",*7
134 . S X=0
135 Q X
Note: See TracBrowser for help on using the repository browser.