- SDPPMT2 ;ALB/CAW - Patient Profile - Means Test (con't) ; 6/3/92
- ;;5.3;Scheduling;**6,1015**;Aug 13, 1993;Build 21
- ;
- 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
- SDPPMT2 ;ALB/CAW - Patient Profile - Means Test (con't) ; 6/3/92
- +1 ;;5.3;Scheduling;**6,1015**;Aug 13, 1993;Build 21
- +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
