SDPPMT2 ;ALB/CAW - Patient Profile - Means Test (con't) ; 6/3/92
;;5.3;Scheduling;**6**;Aug 13, 1993
;
IAI ; Individual Annual Income and Adjudicate Date
S X=""
I $D(SDMT) D
.S X=$$SETSTR^VALM1("Indiv. Ann. Inc.:",X,2,17)
.S Y=$P($G(^DGMT(408.21,+$P(SDMT,U,2),0)),U) D DD^%DT
.S X=$$SETSTR^VALM1(Y,X,SDFST,SDLEN)
I $P(SDMT1,U,10)'="" D
.S X=$$SETSTR^VALM1("Adjudicate Date:",X,43,16)
.S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,10)),X,SDSEC,SDLEN)
I X'="" D SET^SDPPMT1(X)
SPOUSE ; Spouse info
G:'$D(DGINR("S"))!('$D(SDMT)) SPOUSEQ
S X="" I $P(SDMT,U,5)'="" D
.S X=$$SETSTR^VALM1("Mar. Lst. Cal. Yr:",X,1,18)
.S SDYN=$S($P(SDMT,U,5)=1:"YES",$P(SDMT,U,5)=0:"NO",1:"UNKNOWN")
.S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
I $P(SDMT,U,6)'="" D
.S X=$$SETSTR^VALM1("Lived w/Patient:",X,43,16)
.S SDYN=$S($P(SDMT,U,6)=1:"YES",$P(SDMT,U,6)=0:"NO",1:"UNKNOWN")
.S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
D:X'="" SET^SDPPMT1(X)
; Spouse info (con't)
S X="" I $P(SDMT,U,7)'="" D
.S X=$$SETSTR^VALM1("Amt. To Spouse:",X,3,15)
.S X=$$SETSTR^VALM1($P(SDMT,U,7),X,SDFST,SDLEN)
I $P(SDMT,U,10)'="" D
.S X=$$SETSTR^VALM1("Cont. To Support:",X,41,17)
.S SDYN=$S($P(SDMT,U,10)=1:"YES",$P(SDMT,U,10)=0:"NO",1:"UNKNOWN")
.S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
D:X'="" SET^SDPPMT1(X)
SPOUSEQ ;
;
DEP ; Dependent Children Info
;
I '$D(SDMT) G DEPQ
S X="",X=$$SETSTR^VALM1("Dep. Children:",X,5,14)
S SDYN=$S($P(SDMT,U,8)=1:"YES",$P(SDMT,U,8)=0:"NO",1:"UNKNOWN")
S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
I $P(SDMT,U,13)'="" D
.S X=$$SETSTR^VALM1("# Dep. Children:",X,42,16)
.S X=$$SETSTR^VALM1($P(SDMT,U,13),X,SDSEC,SDLEN)
D SET^SDPPMT1(X)
;
G:'$D(DGINR("C")) DEPQ S SDDEP=0
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
.S SDREL=$S(SDWHERE["DGPR":$G(^DGPR(408.13,$P(SDWHERE,";"),0)),1:$G(DPT($P(SDWHERE,";"),0)))
.S X="",X=$$SETSTR^VALM1("**************Dependent "_SDDEP_"***********************",X,15,40) D SET^SDPPMT1(X)
.S X="",X=$$SETSTR^VALM1("Name: ",X,13,6)
.S X=$$SETSTR^VALM1($P(SDREL,U),X,SDFST,SDLEN)
.S X=$$SETSTR^VALM1("Date of Birth: ",X,42,16)
.S X=$$SETSTR^VALM1($$FDATE^SDUL1($P(SDREL,U,3)),X,SDSEC,SDLEN)
.D SET^SDPPMT1(X)
.S X="",X=$$SETSTR^VALM1("Sex:",X,14,4)
.S X=$$SETSTR^VALM1($S($P(SDREL,U,2)="M":"MALE",$P(SDREL,U,2)="F":"FEMALE",1:"UNKNOWN"),X,SDFST,SDLEN)
.I $P(SDMT,U,9)'="" D
..S X=$$SETSTR^VALM1("Inc. of Self Sup.:",X,41,18)
..S SDYN=$S($P(SDMT,U,9)=1:"YES",$P(SDMT,U,9)=0:"NO",1:"UNKNOWN")
..S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
.D SET^SDPPMT1(X)
.; Child Has Income
.S X=""
.I $P(SDMT,U,11)'="" D
..S X=$$SETSTR^VALM1("Child Had Income:",X,2,17)
..S SDYN=$S($P(SDMT,U,11)=1:"YES",$P(SDMT,U,11)=0:"NO",1:"UNKNOWN")
..S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
.D:X'="" SET^SDPPMT1(X)
.; Income Available to You
.S X=""
.I $P(SDMT,U,12)'="" D
..S X=$$SETSTR^VALM1("Inc. Avail To You:",X,1,18)
..S SDYN=$S($P(SDMT,U,12)=1:"YES",$P(SDMT,U,12)=0:"NO",1:"UNKNOWN")
..S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
.D:X'="" SET^SDPPMT1(X)
DEPQ D SET^SDPPMT1("")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPPMT2 3180 printed Oct 16, 2024@19:00:12 Page 2
SDPPMT2 ;ALB/CAW - Patient Profile - Means Test (con't) ; 6/3/92
+1 ;;5.3;Scheduling;**6**;Aug 13, 1993
+2 ;
IAI ; Individual Annual Income and Adjudicate Date
+1 SET X=""
+2 IF $DATA(SDMT)
Begin DoDot:1
+3 SET X=$$SETSTR^VALM1("Indiv. Ann. Inc.:",X,2,17)
+4 SET Y=$PIECE($GET(^DGMT(408.21,+$PIECE(SDMT,U,2),0)),U)
DO DD^%DT
+5 SET X=$$SETSTR^VALM1(Y,X,SDFST,SDLEN)
End DoDot:1
+6 IF $PIECE(SDMT1,U,10)'=""
Begin DoDot:1
+7 SET X=$$SETSTR^VALM1("Adjudicate Date:",X,43,16)
+8 SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDMT1,U,10)),X,SDSEC,SDLEN)
End DoDot:1
+9 IF X'=""
DO SET^SDPPMT1(X)
SPOUSE ; Spouse info
+1 if '$DATA(DGINR("S"))!('$DATA(SDMT))
GOTO SPOUSEQ
+2 SET X=""
IF $PIECE(SDMT,U,5)'=""
Begin DoDot:1
+3 SET X=$$SETSTR^VALM1("Mar. Lst. Cal. Yr:",X,1,18)
+4 SET SDYN=$SELECT($PIECE(SDMT,U,5)=1:"YES",$PIECE(SDMT,U,5)=0:"NO",1:"UNKNOWN")
+5 SET X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
End DoDot:1
+6 IF $PIECE(SDMT,U,6)'=""
Begin DoDot:1
+7 SET X=$$SETSTR^VALM1("Lived w/Patient:",X,43,16)
+8 SET SDYN=$SELECT($PIECE(SDMT,U,6)=1:"YES",$PIECE(SDMT,U,6)=0:"NO",1:"UNKNOWN")
+9 SET X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
End DoDot:1
+10 if X'=""
DO SET^SDPPMT1(X)
+11 ; Spouse info (con't)
+12 SET X=""
IF $PIECE(SDMT,U,7)'=""
Begin DoDot:1
+13 SET X=$$SETSTR^VALM1("Amt. To Spouse:",X,3,15)
+14 SET X=$$SETSTR^VALM1($PIECE(SDMT,U,7),X,SDFST,SDLEN)
End DoDot:1
+15 IF $PIECE(SDMT,U,10)'=""
Begin DoDot:1
+16 SET X=$$SETSTR^VALM1("Cont. To Support:",X,41,17)
+17 SET SDYN=$SELECT($PIECE(SDMT,U,10)=1:"YES",$PIECE(SDMT,U,10)=0:"NO",1:"UNKNOWN")
+18 SET X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
End DoDot:1
+19 if X'=""
DO SET^SDPPMT1(X)
SPOUSEQ ;
+1 ;
DEP ; Dependent Children Info
+1 ;
+2 IF '$DATA(SDMT)
GOTO DEPQ
+3 SET X=""
SET X=$$SETSTR^VALM1("Dep. Children:",X,5,14)
+4 SET SDYN=$SELECT($PIECE(SDMT,U,8)=1:"YES",$PIECE(SDMT,U,8)=0:"NO",1:"UNKNOWN")
+5 SET X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
+6 IF $PIECE(SDMT,U,13)'=""
Begin DoDot:1
+7 SET X=$$SETSTR^VALM1("# Dep. Children:",X,42,16)
+8 SET X=$$SETSTR^VALM1($PIECE(SDMT,U,13),X,SDSEC,SDLEN)
End DoDot:1
+9 DO SET^SDPPMT1(X)
+10 ;
+11 if '$DATA(DGINR("C"))
GOTO DEPQ
SET SDDEP=0
+12 FOR
SET SDDEP=$ORDER(DGINR("C",SDDEP))
if 'SDDEP
QUIT
SET SDMT=$GET(^DGMT(408.22,DGINR("C",SDDEP),0))
SET SDWHERE=$PIECE(DGREL("C",SDDEP),U,2)
Begin DoDot:1
+13 SET SDREL=$SELECT(SDWHERE["DGPR":$GET(^DGPR(408.13,$PIECE(SDWHERE,";"),0)),1:$GET(DPT($PIECE(SDWHERE,";"),0)))
+14 SET X=""
SET X=$$SETSTR^VALM1("**************Dependent "_SDDEP_"***********************",X,15,40)
DO SET^SDPPMT1(X)
+15 SET X=""
SET X=$$SETSTR^VALM1("Name: ",X,13,6)
+16 SET X=$$SETSTR^VALM1($PIECE(SDREL,U),X,SDFST,SDLEN)
+17 SET X=$$SETSTR^VALM1("Date of Birth: ",X,42,16)
+18 SET X=$$SETSTR^VALM1($$FDATE^SDUL1($PIECE(SDREL,U,3)),X,SDSEC,SDLEN)
+19 DO SET^SDPPMT1(X)
+20 SET X=""
SET X=$$SETSTR^VALM1("Sex:",X,14,4)
+21 SET X=$$SETSTR^VALM1($SELECT($PIECE(SDREL,U,2)="M":"MALE",$PIECE(SDREL,U,2)="F":"FEMALE",1:"UNKNOWN"),X,SDFST,SDLEN)
+22 IF $PIECE(SDMT,U,9)'=""
Begin DoDot:2
+23 SET X=$$SETSTR^VALM1("Inc. of Self Sup.:",X,41,18)
+24 SET SDYN=$SELECT($PIECE(SDMT,U,9)=1:"YES",$PIECE(SDMT,U,9)=0:"NO",1:"UNKNOWN")
+25 SET X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
End DoDot:2
+26 DO SET^SDPPMT1(X)
+27 ; Child Has Income
+28 SET X=""
+29 IF $PIECE(SDMT,U,11)'=""
Begin DoDot:2
+30 SET X=$$SETSTR^VALM1("Child Had Income:",X,2,17)
+31 SET SDYN=$SELECT($PIECE(SDMT,U,11)=1:"YES",$PIECE(SDMT,U,11)=0:"NO",1:"UNKNOWN")
+32 SET X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
End DoDot:2
+33 if X'=""
DO SET^SDPPMT1(X)
+34 ; Income Available to You
+35 SET X=""
+36 IF $PIECE(SDMT,U,12)'=""
Begin DoDot:2
+37 SET X=$$SETSTR^VALM1("Inc. Avail To You:",X,1,18)
+38 SET SDYN=$SELECT($PIECE(SDMT,U,12)=1:"YES",$PIECE(SDMT,U,12)=0:"NO",1:"UNKNOWN")
+39 SET X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
End DoDot:2
+40 if X'=""
DO SET^SDPPMT1(X)
End DoDot:1
DEPQ DO SET^SDPPMT1("")
+1 ;
+2 QUIT
