Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMUM6

IVMUM6.m

Go to the documentation of this file. 
  1. IVMUM6 ;ALB/SEK - COMPLETE MEANS TEST ; 23 MAY 94
  1.  ;;2.0;INCOME VERIFICATION MATCH;**1,3,17,115**;21-OCT-94;Build 28
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. EN ; this routine will call MAS routines to determine the following:
  1.  ;        total dependents
  1.  ;        income
  1.  ;        net worth
  1.  ;        deductible expenses
  1.  ;        thresholds
  1.  ;        category
  1.  ;
  1.  ; the above will be added in the ANNUAL MEANS TEST file(#408.31)
  1.  ;
  1.  ; s dgcomf=1 to indicate completing means test which will update
  1.  ; means test ien (field 31) in individual annual income file (408.21)
  1.  ; when called SET^DGMTSCU2
  1.  S DGCOMF=1
  1.  ;
  1.  ; get DGMTPAR - annual means test parameters 0 node from ^DG(43,1,"MT"
  1.  ; if current year parameters are not available DGMTPAR will contain
  1.  ; previous year income parameters and DGMTPAR("PREV") will be defined
  1.  ; indicating such.
  1.  D PAR^DGMTSCU
  1.  ;
  1.  ; d set^dgmtscu2 will create the following variables to update
  1.  ; annual means test file (408.31):
  1.  ;      dgmts - means test status(.03)
  1.  ;      dgint - income(.04)
  1.  ;      dgnwt - net worth(.05)
  1.  ;      dgtha - threshold a(.12)
  1.  ;      dgthb - threshold b(.13)
  1.  ;      dgdet - deductible expenses(.15)
  1.  ;      dgmtpar("prev") - previous years threshold(.16)  (if defined)
  1.  ;      dgnd  - total dependents(.18)
  1.  ;      
  1.  D SET^DGMTSCU2
  1.  ;
  1.  ; setup other variables for 408.31
  1.  S IVMDA1=IVMDAZ D GET^IVMUM1 ; get ZMT segment
  1.  S IVM1=$$FMDATE^HLFNC($P(IVMSEG,"^",10)) ; dt/time completed
  1.  S IVM2=$P(IVMSEG,"^",7) ; agree to pay deductible
  1.  S IVM3=$$FMDATE^HLFNC($P(IVMSEG,"^",15)) ; dt verified test sign
  1.  S IVM4=$P(IVMSEG,"^",16) ; declines to give income info field
  1.  S IVM5=$$FMDATE^HLFNC($P(IVMSEG,"^",6)) ; dt/time of adjudication
  1.  S IVM6=$$FMDATE^HLFNC($P(IVMSEG,"^",20)) ; dt ivm verified mt completed
  1.  S IVM7=$P(IVMSEG,"^",21) ; refuse to sign
  1.  S IVMSTAT=$P(IVMSEG,"^",3) ; means test status
  1.  S IVM8=+$P(IVMSEG,"^",30) ; Means Test Version
  1.  ;
  1.  I IVM4 S DGCAT="C" D STA^DGMTSCU2 ; make cat C if declines to give income info
  1.  ;
  1.  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
  1.  ;
  1.  ; add to annual means test file
  1.  S:'$D(DGTHB) DGTHB=""
  1.  S DA=DGMTI,DIE="^DGMT(408.31,"
  1.  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"
  1.  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"
  1.  I $D(DGMTPAR("PREV")) S DR=DR_";.16////1"
  1.  D ^DIE K DR
  1.  S DR=".1////^S X=IVM5;.25////^S X=IVM6;.26////^S X=IVM7"
  1.  D ^DIE K DA,DIE,DR
  1.  ;
  1.  ; if ivm mt cat diff then calculated cat or still cat a ack msg is
  1.  ; sent to ivm center
  1.  ; dgcat (mt cat) is also created by d set^dgmtscu2
  1.  I IVMSTAT'=DGCAT D  G MTDRIVER
  1.  . S HLERR="Uploaded mt cat should be "_DGCAT
  1.  I DGCAT="A" D
  1.  . S HLERR="Uploaded mt cat is still A"
  1.  ;
  1. MTDRIVER ; call means test event driver
  1.  S DGMTACT="UPL"
  1.  D AFTER^DGMTEVT
  1.  S DGMTINF=1 ; non-interactive flag
  1.  D EN^DGMTEVT
  1.  ;
  1.  ; close IVM case record for patient
  1.  D CLOSE^IVMPTRN1(DGLY,DFN,1,1)
  1.  ;
  1.  ; Get copay exemption status (IVMCEA) and means test status (IVMMTA
  1.  ; after upload.  If different from before upload and send notification
  1.  ; mail message to the site.  Also, send notification mail message if
  1.  ; patient doesn't agree to pay deductible.
  1.  S IVMCNTR=10
  1.  S IVMCEA=$P($$RXST^IBARXEU(DFN),"^",2)
  1.  I IVMCEA'=IVMCEB D
  1.  . S IVMTEXT(10)=""
  1.  . S IVMTEXT(11)="The patient is now "_IVMCEA_" from the prescription copayment."
  1.  . S IVMCNTR=12
  1.  S IVMMTA=$P($$LST^DGMTU(DFN),"^",3)
  1.  I IVMMTA'=IVMMTB D
  1.  . S IVMTEXT(IVMCNTR)=""
  1.  . S IVMTEXT(IVMCNTR+1)="The patient's current Means Test status is now "_IVMMTA_"."
  1.  . S IVMCNTR=IVMCNTR+2
  1.  I 'IVM2 D
  1.  . S IVMTEXT(IVMCNTR)=""
  1.  . I IVM2=0 D  Q
  1.  . . S IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and doesn't agree to pay the deductible."
  1.  . S IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and didn't answer agree to pay the deductible."
  1.  D MTBULL,MAIL^IVMUFNC()
  1.  ;
  1.  ; cleanup
  1.  K DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB
  1.  K IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVMCEA,IVMCEB,IVMMTA,IVM8
  1.  Q
  1.  ;
  1. 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.
  1.  ;
  1.  S IVMPAT=$$PT^IVMUFNC4(DFN)
  1.  S XMSUB="IVM - MEANS TEST UPLOAD for "_$P($P(IVMPAT,"^"),",")_" ("_$P(IVMPAT,"^",3)_")"
  1.  S IVMTEXT(1)="An Income Verification Match verified Means Test has been uploaded"
  1.  S IVMTEXT(2)="for the following patient:"
  1.  S IVMTEXT(3)=" "
  1.  S IVMTEXT(4)="  NAME:           "_$P(IVMPAT,"^")
  1.  S IVMTEXT(5)="  ID:             "_$P(IVMPAT,"^",2)
  1.  S Y=IVMMTDT X ^DD("DD")
  1.  S IVMTEXT(6)="  DATE OF TEST:   "_Y
  1.  S IVMTEXT(7)="  PREV CATEGORY:  "_$P($G(^DG(408.32,+$P(IVMMT31,"^",3),0)),"^",2)
  1.  S IVMTEXT(8)="  NEW CATEGORY:   "_DGCAT
  1.  I IVM5 S Y=IVM5 X ^DD("DD") S IVMTEXT(9)="  DATE/TIME OF ADJUDICATION:  "_Y
  1.  Q