| 1 | SDPPMT1 ;ALB/CAW - Patient Profile - Means Test ; 5/14/92
|
|---|
| 2 | ;;5.3;Scheduling;**6,32**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | EN1 ; Gather Means Test Info
|
|---|
| 6 | N SDM1,SDMT,SDMT1,SDYN,SDM2,SDSTART,SDSTOP
|
|---|
| 7 | S (SDM2,SDX)=0,SDFST=20,SDSEC=60,SDLEN=20,$P(SDASH,"-",IOM+1)="",SDDT=SDED_.99,SDSTART=$S($D(SDBEG):SDBEG,1:SDBD),SDSTOP=$S($D(SDEND):SDEND,1:SDED)
|
|---|
| 8 | I $D(SDY) S SDDT=$P(^DGMT(408.31,SDY,0),U)
|
|---|
| 9 | F S SDX=$$LST^DGMTU(DFN,SDDT) Q:SDX']"" S SDDT=$P(SDX,U,2) Q:'$D(SDY)&(SDDT>SDED!(SDDT<SDBD)) D INIT Q:(SDPRINT)!$D(SDY) S SDDT=SDDT-1
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | INIT ; Set up means test variables
|
|---|
| 13 | D ALL^DGMTU21(DFN,"VSC",SDDT,"IPR")
|
|---|
| 14 | I $D(DGINR("V")) S SDMT=$G(^DGMT(408.22,+DGINR("V"),0))
|
|---|
| 15 | I $D(DGINR("V")) S SDM1=$G(^DGMT(408.21,+DGINC("V"),0))
|
|---|
| 16 | S SDMT1=$G(^DGMT(408.31,+SDX,0))
|
|---|
| 17 | D INFO
|
|---|
| 18 | Q
|
|---|
| 19 | INFO ;
|
|---|
| 20 | ;
|
|---|
| 21 | DATE ; Date of Test and Status
|
|---|
| 22 | S X="",X=$$SETSTR^VALM1("Date of Test:",X,6,13)
|
|---|
| 23 | S X=$$SETSTR^VALM1($$FTIME^VALM1(+SDMT1),X,SDFST,SDLEN)
|
|---|
| 24 | S X=$$SETSTR^VALM1("Status:",X,52,7)
|
|---|
| 25 | S X=$$SETSTR^VALM1($P($G(^DG(408.32,+$P(SDMT1,U,3),0)),U),X,SDSEC,SDLEN)
|
|---|
| 26 | D SET(X)
|
|---|
| 27 | NET ; Net Worth and Income
|
|---|
| 28 | S X="",X=$$SETSTR^VALM1("Net Worth:",X,9,10)
|
|---|
| 29 | S X=$$SETSTR^VALM1($P(SDMT1,U,5),X,SDFST,SDLEN)
|
|---|
| 30 | S X=$$SETSTR^VALM1("Income:",X,52,7)
|
|---|
| 31 | S X=$$SETSTR^VALM1($P(SDMT1,U,4),X,SDSEC,SDLEN)
|
|---|
| 32 | D SET(X)
|
|---|
| 33 | DATEC ; Date Completed and Deductible Expenses
|
|---|
| 34 | S X="",X=$$SETSTR^VALM1("Date Completed:",X,4,15)
|
|---|
| 35 | I $P(SDMT1,U,7)'="" S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,7)),X,SDFST,SDLEN)
|
|---|
| 36 | S X=$$SETSTR^VALM1("Deductible Exp.:",X,43,16)
|
|---|
| 37 | S X=$$SETSTR^VALM1($P(SDMT1,U,15),X,SDSEC,SDLEN)
|
|---|
| 38 | D SET(X)
|
|---|
| 39 | COMP ; Completed By and Agreed to Pay Deductible
|
|---|
| 40 | S X="",X=$$SETSTR^VALM1("Completed By:",X,6,13)
|
|---|
| 41 | S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDMT1,U,6),0)),U),X,SDFST,SDLEN)
|
|---|
| 42 | S SDYN=$S($P(SDMT1,U,11)=1:"YES",$P(SDMT1,U,11)=0:"NO",1:"UNKNOWN")
|
|---|
| 43 | S X=$$SETSTR^VALM1("Will Pay Deduct.:",X,42,17)
|
|---|
| 44 | S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
|
|---|
| 45 | D SET(X)
|
|---|
| 46 | DEC ; Declined to Give Income Info and Date Category Changed
|
|---|
| 47 | S X=""
|
|---|
| 48 | I $P(SDMT1,U,14)'="" D
|
|---|
| 49 | .S X=$$SETSTR^VALM1("Decl To Give Info:",X,1,18)
|
|---|
| 50 | .S SDYN=$S($P(SDMT1,U,14)=1:"YES",$P(SDMT1,U,14)=0:"NO",1:"UNKNOWN")
|
|---|
| 51 | .S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
|
|---|
| 52 | I $P(SDMT1,U,9)'="" D
|
|---|
| 53 | .S X=$$SETSTR^VALM1("Date Cat. Changed:",X,41,18)
|
|---|
| 54 | .S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,9)),X,SDSEC,SDLEN)
|
|---|
| 55 | D:X'="" SET(X)
|
|---|
| 56 | NO ; No Longer Required Date and Category Changed By
|
|---|
| 57 | S X=""
|
|---|
| 58 | I $P(SDMT1,U,17)'="" D
|
|---|
| 59 | .S X=$$SETSTR^VALM1("No Lon. Req. Date:",X,1,18)
|
|---|
| 60 | .S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,17)),X,SDFST,SDLEN)
|
|---|
| 61 | I $P(SDMT1,U,8)'="" D
|
|---|
| 62 | .S X=$$SETSTR^VALM1("Cat. Changed By:",X,43,16)
|
|---|
| 63 | .S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDMT1,U,8),0)),U),X,SDSEC,SDLEN)
|
|---|
| 64 | D:X'="" SET(X)
|
|---|
| 65 | D ^SDPPMT2
|
|---|
| 66 | Q
|
|---|
| 67 | SET(X) ; Set in ^TMP global for display
|
|---|
| 68 | ;
|
|---|
| 69 | S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
|
|---|
| 70 | Q
|
|---|
| 71 | QUIT ;
|
|---|
| 72 | K SDASH,SDFST,SDLEN,SDM,SDM1,SDMT,SDMT1,SDSEC,SDX,SDY,SDYN,^TMP("SDPPENR",$J)
|
|---|
| 73 | Q
|
|---|
