source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDPPMT2.m@ 1114

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1SDPPMT2 ;ALB/CAW - Patient Profile - Means Test (con't) ; 6/3/92
2 ;;5.3;Scheduling;**6**;Aug 13, 1993
3 ;
4IAI ; Individual Annual Income and Adjudicate Date
5 S X=""
6 I $D(SDMT) D
7 .S X=$$SETSTR^VALM1("Indiv. Ann. Inc.:",X,2,17)
8 .S Y=$P($G(^DGMT(408.21,+$P(SDMT,U,2),0)),U) D DD^%DT
9 .S X=$$SETSTR^VALM1(Y,X,SDFST,SDLEN)
10 I $P(SDMT1,U,10)'="" D
11 .S X=$$SETSTR^VALM1("Adjudicate Date:",X,43,16)
12 .S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,10)),X,SDSEC,SDLEN)
13 I X'="" D SET^SDPPMT1(X)
14SPOUSE ; Spouse info
15 G:'$D(DGINR("S"))!('$D(SDMT)) SPOUSEQ
16 S X="" I $P(SDMT,U,5)'="" D
17 .S X=$$SETSTR^VALM1("Mar. Lst. Cal. Yr:",X,1,18)
18 .S SDYN=$S($P(SDMT,U,5)=1:"YES",$P(SDMT,U,5)=0:"NO",1:"UNKNOWN")
19 .S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
20 I $P(SDMT,U,6)'="" D
21 .S X=$$SETSTR^VALM1("Lived w/Patient:",X,43,16)
22 .S SDYN=$S($P(SDMT,U,6)=1:"YES",$P(SDMT,U,6)=0:"NO",1:"UNKNOWN")
23 .S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
24 D:X'="" SET^SDPPMT1(X)
25 ; Spouse info (con't)
26 S X="" I $P(SDMT,U,7)'="" D
27 .S X=$$SETSTR^VALM1("Amt. To Spouse:",X,3,15)
28 .S X=$$SETSTR^VALM1($P(SDMT,U,7),X,SDFST,SDLEN)
29 I $P(SDMT,U,10)'="" D
30 .S X=$$SETSTR^VALM1("Cont. To Support:",X,41,17)
31 .S SDYN=$S($P(SDMT,U,10)=1:"YES",$P(SDMT,U,10)=0:"NO",1:"UNKNOWN")
32 .S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
33 D:X'="" SET^SDPPMT1(X)
34SPOUSEQ ;
35 ;
36DEP ; Dependent Children Info
37 ;
38 I '$D(SDMT) G DEPQ
39 S X="",X=$$SETSTR^VALM1("Dep. Children:",X,5,14)
40 S SDYN=$S($P(SDMT,U,8)=1:"YES",$P(SDMT,U,8)=0:"NO",1:"UNKNOWN")
41 S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
42 I $P(SDMT,U,13)'="" D
43 .S X=$$SETSTR^VALM1("# Dep. Children:",X,42,16)
44 .S X=$$SETSTR^VALM1($P(SDMT,U,13),X,SDSEC,SDLEN)
45 D SET^SDPPMT1(X)
46 ;
47 G:'$D(DGINR("C")) DEPQ S SDDEP=0
48 F S SDDEP=$O(DGINR("C",SDDEP)) Q:'SDDEP S SDMT=$G(^DGMT(408.22,DGINR("C",SDDEP),0)),SDWHERE=$P(DGREL("C",SDDEP),U,2) D
49 .S SDREL=$S(SDWHERE["DGPR":$G(^DGPR(408.13,$P(SDWHERE,";"),0)),1:$G(DPT($P(SDWHERE,";"),0)))
50 .S X="",X=$$SETSTR^VALM1("**************Dependent "_SDDEP_"***********************",X,15,40) D SET^SDPPMT1(X)
51 .S X="",X=$$SETSTR^VALM1("Name: ",X,13,6)
52 .S X=$$SETSTR^VALM1($P(SDREL,U),X,SDFST,SDLEN)
53 .S X=$$SETSTR^VALM1("Date of Birth: ",X,42,16)
54 .S X=$$SETSTR^VALM1($$FDATE^SDUL1($P(SDREL,U,3)),X,SDSEC,SDLEN)
55 .D SET^SDPPMT1(X)
56 .S X="",X=$$SETSTR^VALM1("Sex:",X,14,4)
57 .S X=$$SETSTR^VALM1($S($P(SDREL,U,2)="M":"MALE",$P(SDREL,U,2)="F":"FEMALE",1:"UNKNOWN"),X,SDFST,SDLEN)
58 .I $P(SDMT,U,9)'="" D
59 ..S X=$$SETSTR^VALM1("Inc. of Self Sup.:",X,41,18)
60 ..S SDYN=$S($P(SDMT,U,9)=1:"YES",$P(SDMT,U,9)=0:"NO",1:"UNKNOWN")
61 ..S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
62 .D SET^SDPPMT1(X)
63 .; Child Has Income
64 .S X=""
65 .I $P(SDMT,U,11)'="" D
66 ..S X=$$SETSTR^VALM1("Child Had Income:",X,2,17)
67 ..S SDYN=$S($P(SDMT,U,11)=1:"YES",$P(SDMT,U,11)=0:"NO",1:"UNKNOWN")
68 ..S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
69 .D:X'="" SET^SDPPMT1(X)
70 .; Income Available to You
71 .S X=""
72 .I $P(SDMT,U,12)'="" D
73 ..S X=$$SETSTR^VALM1("Inc. Avail To You:",X,1,18)
74 ..S SDYN=$S($P(SDMT,U,12)=1:"YES",$P(SDMT,U,12)=0:"NO",1:"UNKNOWN")
75 ..S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
76 .D:X'="" SET^SDPPMT1(X)
77DEPQ D SET^SDPPMT1("")
78 ;
79 Q
Note: See TracBrowser for help on using the repository browser.