Routine: SDPPMT1

SDPPMT1 ;ALB/CAW - Patient Profile - Means Test ; 5/14/92

 ;;5.3;Scheduling;**6,32**;Aug 13, 1993

EN1 ; Gather Means Test Info

 N SDM1,SDMT,SDMT1,SDYN,SDM2,SDSTART,SDSTOP

 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)

 I $D(SDY) S SDDT=$P(^DGMT(408.31,SDY,0),U)

 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

INIT ; Set up means test variables

 D ALL^DGMTU21(DFN,"VSC",SDDT,"IPR")

 I $D(DGINR("V")) S SDMT=$G(^DGMT(408.22,+DGINR("V"),0))

 I $D(DGINR("V")) S SDM1=$G(^DGMT(408.21,+DGINC("V"),0))

 S SDMT1=$G(^DGMT(408.31,+SDX,0))

 D INFO

INFO ;

DATE ; Date of Test and Status

 S X="",X=$$SETSTR^VALM1("Date of Test:",X,6,13)

 S X=$$SETSTR^VALM1($$FTIME^VALM1(+SDMT1),X,SDFST,SDLEN)

 S X=$$SETSTR^VALM1("Status:",X,52,7)

 S X=$$SETSTR^VALM1($P($G(^DG(408.32,+$P(SDMT1,U,3),0)),U),X,SDSEC,SDLEN)

 D SET(X)

NET ; Net Worth and Income

 S X="",X=$$SETSTR^VALM1("Net Worth:",X,9,10)

 S X=$$SETSTR^VALM1($P(SDMT1,U,5),X,SDFST,SDLEN)

 S X=$$SETSTR^VALM1("Income:",X,52,7)

 S X=$$SETSTR^VALM1($P(SDMT1,U,4),X,SDSEC,SDLEN)

 D SET(X)

DATEC ; Date Completed and Deductible Expenses

 S X="",X=$$SETSTR^VALM1("Date Completed:",X,4,15)

 I $P(SDMT1,U,7)'="" S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,7)),X,SDFST,SDLEN)

 S X=$$SETSTR^VALM1("Deductible Exp.:",X,43,16)

 S X=$$SETSTR^VALM1($P(SDMT1,U,15),X,SDSEC,SDLEN)

 D SET(X)

COMP ; Completed By and Agreed to Pay Deductible

 S X="",X=$$SETSTR^VALM1("Completed By:",X,6,13)

 S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDMT1,U,6),0)),U),X,SDFST,SDLEN)

 S SDYN=$S($P(SDMT1,U,11)=1:"YES",$P(SDMT1,U,11)=0:"NO",1:"UNKNOWN")

 S X=$$SETSTR^VALM1("Will Pay Deduct.:",X,42,17)

 S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)

 D SET(X)

DEC ; Declined to Give Income Info and Date Category Changed

 S X=""

 I $P(SDMT1,U,14)'="" D

 .S X=$$SETSTR^VALM1("Decl To Give Info:",X,1,18)

 .S SDYN=$S($P(SDMT1,U,14)=1:"YES",$P(SDMT1,U,14)=0:"NO",1:"UNKNOWN")

 .S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)

 I $P(SDMT1,U,9)'="" D

 .S X=$$SETSTR^VALM1("Date Cat. Changed:",X,41,18)

 .S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,9)),X,SDSEC,SDLEN)

 D:X'="" SET(X)

NO ; No Longer Required Date and Category Changed By

 S X=""

 I $P(SDMT1,U,17)'="" D

 .S X=$$SETSTR^VALM1("No Lon. Req. Date:",X,1,18)

 .S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDMT1,U,17)),X,SDFST,SDLEN)

 I $P(SDMT1,U,8)'="" D

 .S X=$$SETSTR^VALM1("Cat. Changed By:",X,43,16)

 .S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDMT1,U,8),0)),U),X,SDSEC,SDLEN)

 D:X'="" SET(X)

 D ^SDPPMT2

SET(X) ; Set in ^TMP global for display

 S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X

QUIT ;

 K SDASH,SDFST,SDLEN,SDM,SDM1,SDMT,SDMT1,SDSEC,SDX,SDY,SDYN,^TMP("SDPPENR",$J)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPPMT1   2898     printed  Feb 19, 2025@00:26:18                                                                                                                                                                                                     Page 2

SDPPMT1   ;ALB/CAW - Patient Profile - Means Test ; 5/14/92

 +1       ;;5.3;Scheduling;**6,32**;Aug 13, 1993

 +2       ;

 +3       ;

EN1       ; Gather Means Test Info

 +1        NEW SDM1,SDMT,SDMT1,SDYN,SDM2,SDSTART,SDSTOP

 +2        SET (SDM2,SDX)=0

           SET SDFST=20

           SET SDSEC=60

           SET SDLEN=20

           SET $PIECE(SDASH,"-",IOM+1)=""

           SET SDDT=SDED_.99

           SET SDSTART=$SELECT($DATA(SDBEG):SDBEG,1:SDBD)

           SET SDSTOP=$SELECT($DATA(SDEND):SDEND,1:SDED)

 +3        IF $DATA(SDY)

               SET SDDT=$PIECE(^DGMT(408.31,SDY,0),U)

 +4        FOR

               SET SDX=$$LST^DGMTU(DFN,SDDT)

               if SDX']""

                   QUIT

               SET SDDT=$PIECE(SDX,U,2)

               if '$DATA(SDY)&(SDDT>SDED!(SDDT<SDBD))

                   QUIT

               DO INIT

               if (SDPRINT)!$DATA(SDY)

                   QUIT

               SET SDDT=SDDT-1

 +5        QUIT

 +6       ;

INIT      ; Set up means test variables

 +1        DO ALL^DGMTU21(DFN,"VSC",SDDT,"IPR")

 +2        IF $DATA(DGINR("V"))

               SET SDMT=$GET(^DGMT(408.22,+DGINR("V"),0))

 +3        IF $DATA(DGINR("V"))

               SET SDM1=$GET(^DGMT(408.21,+DGINC("V"),0))

 +4        SET SDMT1=$GET(^DGMT(408.31,+SDX,0))

 +5        DO INFO

 +6        QUIT

INFO      ;

 +1       ;

DATE      ; Date of Test and Status

 +1        SET X=""

           SET X=$$SETSTR^VALM1("Date of Test:",X,6,13)

 +2        SET X=$$SETSTR^VALM1($$FTIME^VALM1(+SDMT1),X,SDFST,SDLEN)

 +3        SET X=$$SETSTR^VALM1("Status:",X,52,7)

 +4        SET X=$$SETSTR^VALM1($PIECE($GET(^DG(408.32,+$PIECE(SDMT1,U,3),0)),U),X,SDSEC,SDLEN)

 +5        DO SET(X)

NET       ; Net Worth and Income

 +1        SET X=""

           SET X=$$SETSTR^VALM1("Net Worth:",X,9,10)

 +2        SET X=$$SETSTR^VALM1($PIECE(SDMT1,U,5),X,SDFST,SDLEN)

 +3        SET X=$$SETSTR^VALM1("Income:",X,52,7)

 +4        SET X=$$SETSTR^VALM1($PIECE(SDMT1,U,4),X,SDSEC,SDLEN)

 +5        DO SET(X)

DATEC     ; Date Completed and Deductible Expenses

 +1        SET X=""

           SET X=$$SETSTR^VALM1("Date Completed:",X,4,15)

 +2        IF $PIECE(SDMT1,U,7)'=""

               SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDMT1,U,7)),X,SDFST,SDLEN)

 +3        SET X=$$SETSTR^VALM1("Deductible Exp.:",X,43,16)

 +4        SET X=$$SETSTR^VALM1($PIECE(SDMT1,U,15),X,SDSEC,SDLEN)

 +5        DO SET(X)

COMP      ; Completed By and Agreed to Pay Deductible

 +1        SET X=""

           SET X=$$SETSTR^VALM1("Completed By:",X,6,13)

 +2        SET X=$$SETSTR^VALM1($PIECE($GET(^VA(200,+$PIECE(SDMT1,U,6),0)),U),X,SDFST,SDLEN)

 +3        SET SDYN=$SELECT($PIECE(SDMT1,U,11)=1:"YES",$PIECE(SDMT1,U,11)=0:"NO",1:"UNKNOWN")

 +4        SET X=$$SETSTR^VALM1("Will Pay Deduct.:",X,42,17)

 +5        SET X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)

 +6        DO SET(X)

DEC       ; Declined to Give Income Info and Date Category Changed

 +1        SET X=""

 +2        IF $PIECE(SDMT1,U,14)'=""

               Begin DoDot:1

 +3                SET X=$$SETSTR^VALM1("Decl To Give Info:",X,1,18)

 +4                SET SDYN=$SELECT($PIECE(SDMT1,U,14)=1:"YES",$PIECE(SDMT1,U,14)=0:"NO",1:"UNKNOWN")

 +5                SET X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)

               End DoDot:1

 +6        IF $PIECE(SDMT1,U,9)'=""

               Begin DoDot:1

 +7                SET X=$$SETSTR^VALM1("Date Cat. Changed:",X,41,18)

 +8                SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDMT1,U,9)),X,SDSEC,SDLEN)

               End DoDot:1

 +9        if X'=""

               DO SET(X)

NO        ; No Longer Required Date and Category Changed By

 +1        SET X=""

 +2        IF $PIECE(SDMT1,U,17)'=""

               Begin DoDot:1

 +3                SET X=$$SETSTR^VALM1("No Lon. Req. Date:",X,1,18)

 +4                SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(SDMT1,U,17)),X,SDFST,SDLEN)

               End DoDot:1

 +5        IF $PIECE(SDMT1,U,8)'=""

               Begin DoDot:1

 +6                SET X=$$SETSTR^VALM1("Cat. Changed By:",X,43,16)

 +7                SET X=$$SETSTR^VALM1($PIECE($GET(^VA(200,+$PIECE(SDMT1,U,8),0)),U),X,SDSEC,SDLEN)

               End DoDot:1

 +8        if X'=""

               DO SET(X)

 +9        DO ^SDPPMT2

 +10       QUIT

SET(X)    ; Set in ^TMP global for display

 +1       ;

 +2        SET SDLN=SDLN+1

           SET ^TMP("SDPPALL",$JOB,SDLN,0)=X

 +3        QUIT

QUIT      ;

 +1        KILL SDASH,SDFST,SDLEN,SDM,SDM1,SDMT,SDMT1,SDSEC,SDX,SDY,SDYN,^TMP("SDPPENR",$JOB)

 +2        QUIT

SDPPMT1.m