IVMUM6 ;ALB/SEK - COMPLETE MEANS TEST ; 23 MAY 94
;;2.0;INCOME VERIFICATION MATCH;**1,3,17,115**;21-OCT-94;Build 28
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; this routine will call MAS routines to determine the following:
; total dependents
; income
; net worth
; deductible expenses
; thresholds
; category
;
; the above will be added in the ANNUAL MEANS TEST file(#408.31)
;
; s dgcomf=1 to indicate completing means test which will update
; means test ien (field 31) in individual annual income file (408.21)
; when called SET^DGMTSCU2
S DGCOMF=1
;
; get DGMTPAR - annual means test parameters 0 node from ^DG(43,1,"MT"
; if current year parameters are not available DGMTPAR will contain
; previous year income parameters and DGMTPAR("PREV") will be defined
; indicating such.
D PAR^DGMTSCU
;
; d set^dgmtscu2 will create the following variables to update
; annual means test file (408.31):
; dgmts - means test status(.03)
; dgint - income(.04)
; dgnwt - net worth(.05)
; dgtha - threshold a(.12)
; dgthb - threshold b(.13)
; dgdet - deductible expenses(.15)
; dgmtpar("prev") - previous years threshold(.16) (if defined)
; dgnd - total dependents(.18)
;
D SET^DGMTSCU2
;
; setup other variables for 408.31
S IVMDA1=IVMDAZ D GET^IVMUM1 ; get ZMT segment
S IVM1=$$FMDATE^HLFNC($P(IVMSEG,"^",10)) ; dt/time completed
S IVM2=$P(IVMSEG,"^",7) ; agree to pay deductible
S IVM3=$$FMDATE^HLFNC($P(IVMSEG,"^",15)) ; dt verified test sign
S IVM4=$P(IVMSEG,"^",16) ; declines to give income info field
S IVM5=$$FMDATE^HLFNC($P(IVMSEG,"^",6)) ; dt/time of adjudication
S IVM6=$$FMDATE^HLFNC($P(IVMSEG,"^",20)) ; dt ivm verified mt completed
S IVM7=$P(IVMSEG,"^",21) ; refuse to sign
S IVMSTAT=$P(IVMSEG,"^",3) ; means test status
S IVM8=+$P(IVMSEG,"^",30) ; Means Test Version
;
I IVM4 S DGCAT="C" D STA^DGMTSCU2 ; make cat C if declines to give income info
;
I DGTYC="M",(DGNWT+DGINT-DGDET)>$P(DGMTPAR,"^",8) S DGCAT="C" D STA^DGMTSCU2 ; if cat A for income make cat C if high assets
;
; add to annual means test file
S:'$D(DGTHB) DGTHB=""
S DA=DGMTI,DIE="^DGMT(408.31,"
S DR=".03////^S X=DGMTS;.04////^S X=DGINT;.05////^S X=DGNWT;.06////^S X=DUZ;.07////^S X=IVM1;.11////^S X=IVM2"
S DR=DR_";.12////^S X=DGTHA;.13////^S X=DGTHB;.14////^S X=IVM4;.15////^S X=DGDET;.18////^S X=DGND;.23////2;.24////^S X=IVM3;2.11////^S X=IVM8"
I $D(DGMTPAR("PREV")) S DR=DR_";.16////1"
D ^DIE K DR
S DR=".1////^S X=IVM5;.25////^S X=IVM6;.26////^S X=IVM7"
D ^DIE K DA,DIE,DR
;
; if ivm mt cat diff then calculated cat or still cat a ack msg is
; sent to ivm center
; dgcat (mt cat) is also created by d set^dgmtscu2
I IVMSTAT'=DGCAT D G MTDRIVER
. S HLERR="Uploaded mt cat should be "_DGCAT
I DGCAT="A" D
. S HLERR="Uploaded mt cat is still A"
;
MTDRIVER ; call means test event driver
S DGMTACT="UPL"
D AFTER^DGMTEVT
S DGMTINF=1 ; non-interactive flag
D EN^DGMTEVT
;
; close IVM case record for patient
D CLOSE^IVMPTRN1(DGLY,DFN,1,1)
;
; Get copay exemption status (IVMCEA) and means test status (IVMMTA
; after upload. If different from before upload and send notification
; mail message to the site. Also, send notification mail message if
; patient doesn't agree to pay deductible.
S IVMCNTR=10
S IVMCEA=$P($$RXST^IBARXEU(DFN),"^",2)
I IVMCEA'=IVMCEB D
. S IVMTEXT(10)=""
. S IVMTEXT(11)="The patient is now "_IVMCEA_" from the prescription copayment."
. S IVMCNTR=12
S IVMMTA=$P($$LST^DGMTU(DFN),"^",3)
I IVMMTA'=IVMMTB D
. S IVMTEXT(IVMCNTR)=""
. S IVMTEXT(IVMCNTR+1)="The patient's current Means Test status is now "_IVMMTA_"."
. S IVMCNTR=IVMCNTR+2
I 'IVM2 D
. S IVMTEXT(IVMCNTR)=""
. I IVM2=0 D Q
. . S IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and doesn't agree to pay the deductible."
. S IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and didn't answer agree to pay the deductible."
D MTBULL,MAIL^IVMUFNC()
;
; cleanup
K DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB
K IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVMCEA,IVMCEB,IVMMTA,IVM8
Q
;
MTBULL ; build mail message for transmission to IVM mail group notifying them
; an IVM verified means test has been uploaded into DHCP for a patient.
;
S IVMPAT=$$PT^IVMUFNC4(DFN)
S XMSUB="IVM - MEANS TEST UPLOAD for "_$P($P(IVMPAT,"^"),",")_" ("_$P(IVMPAT,"^",3)_")"
S IVMTEXT(1)="An Income Verification Match verified Means Test has been uploaded"
S IVMTEXT(2)="for the following patient:"
S IVMTEXT(3)=" "
S IVMTEXT(4)=" NAME: "_$P(IVMPAT,"^")
S IVMTEXT(5)=" ID: "_$P(IVMPAT,"^",2)
S Y=IVMMTDT X ^DD("DD")
S IVMTEXT(6)=" DATE OF TEST: "_Y
S IVMTEXT(7)=" PREV CATEGORY: "_$P($G(^DG(408.32,+$P(IVMMT31,"^",3),0)),"^",2)
S IVMTEXT(8)=" NEW CATEGORY: "_DGCAT
I IVM5 S Y=IVM5 X ^DD("DD") S IVMTEXT(9)=" DATE/TIME OF ADJUDICATION: "_Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMUM6 5065 printed Apr 09, 2024@21:02:02 Page 2
IVMUM6 ;ALB/SEK - COMPLETE MEANS TEST ; 23 MAY 94
+1 ;;2.0;INCOME VERIFICATION MATCH;**1,3,17,115**;21-OCT-94;Build 28
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; this routine will call MAS routines to determine the following:
+1 ; total dependents
+2 ; income
+3 ; net worth
+4 ; deductible expenses
+5 ; thresholds
+6 ; category
+7 ;
+8 ; the above will be added in the ANNUAL MEANS TEST file(#408.31)
+9 ;
+10 ; s dgcomf=1 to indicate completing means test which will update
+11 ; means test ien (field 31) in individual annual income file (408.21)
+12 ; when called SET^DGMTSCU2
+13 SET DGCOMF=1
+14 ;
+15 ; get DGMTPAR - annual means test parameters 0 node from ^DG(43,1,"MT"
+16 ; if current year parameters are not available DGMTPAR will contain
+17 ; previous year income parameters and DGMTPAR("PREV") will be defined
+18 ; indicating such.
+19 DO PAR^DGMTSCU
+20 ;
+21 ; d set^dgmtscu2 will create the following variables to update
+22 ; annual means test file (408.31):
+23 ; dgmts - means test status(.03)
+24 ; dgint - income(.04)
+25 ; dgnwt - net worth(.05)
+26 ; dgtha - threshold a(.12)
+27 ; dgthb - threshold b(.13)
+28 ; dgdet - deductible expenses(.15)
+29 ; dgmtpar("prev") - previous years threshold(.16) (if defined)
+30 ; dgnd - total dependents(.18)
+31 ;
+32 DO SET^DGMTSCU2
+33 ;
+34 ; setup other variables for 408.31
+35 ; get ZMT segment
SET IVMDA1=IVMDAZ
DO GET^IVMUM1
+36 ; dt/time completed
SET IVM1=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",10))
+37 ; agree to pay deductible
SET IVM2=$PIECE(IVMSEG,"^",7)
+38 ; dt verified test sign
SET IVM3=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",15))
+39 ; declines to give income info field
SET IVM4=$PIECE(IVMSEG,"^",16)
+40 ; dt/time of adjudication
SET IVM5=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",6))
+41 ; dt ivm verified mt completed
SET IVM6=$$FMDATE^HLFNC($PIECE(IVMSEG,"^",20))
+42 ; refuse to sign
SET IVM7=$PIECE(IVMSEG,"^",21)
+43 ; means test status
SET IVMSTAT=$PIECE(IVMSEG,"^",3)
+44 ; Means Test Version
SET IVM8=+$PIECE(IVMSEG,"^",30)
+45 ;
+46 ; make cat C if declines to give income info
IF IVM4
SET DGCAT="C"
DO STA^DGMTSCU2
+47 ;
+48 ; if cat A for income make cat C if high assets
IF DGTYC="M"
IF (DGNWT+DGINT-DGDET)>$PIECE(DGMTPAR,"^",8)
SET DGCAT="C"
DO STA^DGMTSCU2
+49 ;
+50 ; add to annual means test file
+51 if '$DATA(DGTHB)
SET DGTHB=""
+52 SET DA=DGMTI
SET DIE="^DGMT(408.31,"
+53 SET DR=".03////^S X=DGMTS;.04////^S X=DGINT;.05////^S X=DGNWT;.06////^S X=DUZ;.07////^S X=IVM1;.11////^S X=IVM2"
+54 SET DR=DR_";.12////^S X=DGTHA;.13////^S X=DGTHB;.14////^S X=IVM4;.15////^S X=DGDET;.18////^S X=DGND;.23////2;.24////^S X=IVM3;2.11////^S X=IVM8"
+55 IF $DATA(DGMTPAR("PREV"))
SET DR=DR_";.16////1"
+56 DO ^DIE
KILL DR
+57 SET DR=".1////^S X=IVM5;.25////^S X=IVM6;.26////^S X=IVM7"
+58 DO ^DIE
KILL DA,DIE,DR
+59 ;
+60 ; if ivm mt cat diff then calculated cat or still cat a ack msg is
+61 ; sent to ivm center
+62 ; dgcat (mt cat) is also created by d set^dgmtscu2
+63 IF IVMSTAT'=DGCAT
Begin DoDot:1
+64 SET HLERR="Uploaded mt cat should be "_DGCAT
End DoDot:1
GOTO MTDRIVER
+65 IF DGCAT="A"
Begin DoDot:1
+66 SET HLERR="Uploaded mt cat is still A"
End DoDot:1
+67 ;
MTDRIVER ; call means test event driver
+1 SET DGMTACT="UPL"
+2 DO AFTER^DGMTEVT
+3 ; non-interactive flag
SET DGMTINF=1
+4 DO EN^DGMTEVT
+5 ;
+6 ; close IVM case record for patient
+7 DO CLOSE^IVMPTRN1(DGLY,DFN,1,1)
+8 ;
+9 ; Get copay exemption status (IVMCEA) and means test status (IVMMTA
+10 ; after upload. If different from before upload and send notification
+11 ; mail message to the site. Also, send notification mail message if
+12 ; patient doesn't agree to pay deductible.
+13 SET IVMCNTR=10
+14 SET IVMCEA=$PIECE($$RXST^IBARXEU(DFN),"^",2)
+15 IF IVMCEA'=IVMCEB
Begin DoDot:1
+16 SET IVMTEXT(10)=""
+17 SET IVMTEXT(11)="The patient is now "_IVMCEA_" from the prescription copayment."
+18 SET IVMCNTR=12
End DoDot:1
+19 SET IVMMTA=$PIECE($$LST^DGMTU(DFN),"^",3)
+20 IF IVMMTA'=IVMMTB
Begin DoDot:1
+21 SET IVMTEXT(IVMCNTR)=""
+22 SET IVMTEXT(IVMCNTR+1)="The patient's current Means Test status is now "_IVMMTA_"."
+23 SET IVMCNTR=IVMCNTR+2
End DoDot:1
+24 IF 'IVM2
Begin DoDot:1
+25 SET IVMTEXT(IVMCNTR)=""
+26 IF IVM2=0
Begin DoDot:2
+27 SET IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and doesn't agree to pay the deductible."
End DoDot:2
QUIT
+28 SET IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and didn't answer agree to pay the deductible."
End DoDot:1
+29 DO MTBULL
DO MAIL^IVMUFNC()
+30 ;
+31 ; cleanup
+32 KILL DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB
+33 KILL IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVMCEA,IVMCEB,IVMMTA,IVM8
+34 QUIT
+35 ;
MTBULL ; build mail message for transmission to IVM mail group notifying them
+1 ; an IVM verified means test has been uploaded into DHCP for a patient.
+2 ;
+3 SET IVMPAT=$$PT^IVMUFNC4(DFN)
+4 SET XMSUB="IVM - MEANS TEST UPLOAD for "_$PIECE($PIECE(IVMPAT,"^"),",")_" ("_$PIECE(IVMPAT,"^",3)_")"
+5 SET IVMTEXT(1)="An Income Verification Match verified Means Test has been uploaded"
+6 SET IVMTEXT(2)="for the following patient:"
+7 SET IVMTEXT(3)=" "
+8 SET IVMTEXT(4)=" NAME: "_$PIECE(IVMPAT,"^")
+9 SET IVMTEXT(5)=" ID: "_$PIECE(IVMPAT,"^",2)
+10 SET Y=IVMMTDT
XECUTE ^DD("DD")
+11 SET IVMTEXT(6)=" DATE OF TEST: "_Y
+12 SET IVMTEXT(7)=" PREV CATEGORY: "_$PIECE($GET(^DG(408.32,+$PIECE(IVMMT31,"^",3),0)),"^",2)
+13 SET IVMTEXT(8)=" NEW CATEGORY: "_DGCAT
+14 IF IVM5
SET Y=IVM5
XECUTE ^DD("DD")
SET IVMTEXT(9)=" DATE/TIME OF ADJUDICATION: "_Y
+15 QUIT
