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

IVMCM6.m

Go to the documentation of this file. 
  1. IVMCM6 ;ALB/SEK,JAN,RTK,CKN,TDM,GN,HM - COMPLETE DCD INCOME TEST ;4/10/20 11:41am
  1.  ;;2.0;INCOME VERIFICATION MATCH;**17,25,39,44,50,53,49,58,62,67,84,115,136,190,193**;21-OCT-94;Build 37
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ;IVM*2*84 - insure DGMTP is defined by LTC test prior to calling
  1.  ;           audit
  1.  ;
  1. EN ; This routine will update annual means test file (#408.31):
  1.  ;      
  1.  ; Note: There is no entry in 408.31 for income screening.
  1.  ;
  1.  ;
  1.  ;Input:
  1.  ;  DGMTI - ien of new Annual Means Test which requires completion
  1.  ;  IVMMTIEN - ien of replaced test (may not exist)
  1.  ;
  1.  ; - open case record in (#301.5) file
  1.  N DGREF,DATA,CODE,FIELD,RET,NODE0,NODE2,OK2SND
  1.  D CHKTST,OPEN
  1.  ;
  1.  ; - if income screening goto MTBULL
  1.  I IVMTYPE=3 G MTBULL
  1.  ;
  1.  ; - setup variables for (#408.31) file
  1.  ;get the ZMT segment, translate HLQ's to NULLS
  1.  S IVMSEG=$G(^TMP($J,"IVMCM","ZMT"_IVMTYPE)) ; get mt/copay ZMT segment
  1.  F FIELD=4:1:32 I FIELD'=24,$P(IVMSEG,HLFS,FIELD)=HLQ S $P(IVMSEG,HLFS,FIELD)="" ;IVM*2.0*193
  1.  ;
  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 vet signed test
  1.  S IVM4=$P(IVMSEG,"^",16) ; declines to give income info field
  1.  S:IVM4 DGREF=""
  1.  S IVM5=$$FMDATE^HLFNC($P(IVMSEG,"^",6)) ; dt/time of adjudication
  1.  S IVM6=$P(IVMSEG,"^",3) ;status
  1.  S IVM7=$P(IVMSEG,"^",13) ; hardship
  1.  S:$G(IVMHADJ) IVMCAT=$P(IVMSEG,"^",3) ; test status 
  1.  S IVM8=$P(IVMSEG,"^",22) ; site conducting test
  1.  S IVM9=$P(IVMSEG,"^",23) ; site granting hardship
  1.  S IVM10=$P(IVMSEG,"^",11) ; prev years threshold
  1.  S IVM11=$P(IVMSEG,"^",18) ; source of test
  1.  S IVM12=$$FMDATE^HLFNC($P(IVMSEG,"^",24)) ; hardship effective date
  1.  S IVM13=$$FMDATE^HLFNC($P(IVMSEG,"^",25)) ; date/time last edited
  1.  S IVM14=$P(IVMSEG,"^",26) ; test determined status
  1.  S IVM15=$P(IVMSEG,"^",4) ; income 
  1.  S IVM16=$P(IVMSEG,"^",5) ; net worth
  1.  S IVM17=$P(IVMSEG,"^",8) ; threshold A
  1.  S IVM18=$P(IVMSEG,"^",9) ; deductible expenses
  1.  S IVM19=$P(IVMSEG,"^",12) ; total dependents
  1.  S IVM20=$P(IVMSEG,"^",27) ; signature valid?
  1.  S IVM21=$$FMDATE^HLFNC($P(IVMSEG,"^",14)) ; hardship review date
  1.  S IVM22=$P(IVMSEG,"^",28) ; GMT threshold
  1.  S IVM23=$P(IVMSEG,"^",29) ; hardship reason
  1.  S IVM24=+$P(IVMSEG,"^",30) ; Means Test Version
  1.  S IVM25=$$FMDATE^HLFNC($P(IVMSEG,"^",2)) ;Means Test Date ;IVM*2.0*190
  1.  S IVM26=$$FMDATE^HLFNC($P(IVMSEG,"^",32)) ;Hardship Expiration Date ;IVM*2.0*193
  1.  S DATA(2.13)=IVM26  ; IVM*2.0*193
  1.  ;IVM*2.0*193;HM; when Hardship Expiration Date is after effective date and not a future date
  1.  ;  - set Hardship to "NO" and Hardship Expired to "YES"
  1.  I IVM26'="",(IVM12<=IVM26)&(IVM26<=DT) D
  1.  .S IVM7=0,DATA(.2)=IVM7
  1.  .S DATA(2.12)=1
  1.  ;
  1.  ;old tests may not have the field Test-Determined Status
  1.  I IVM14="" D
  1.  . I IVMTYPE=1,IVM7,"AG"[IVM6 D  Q
  1.  . . I IVM6="A",(IVM15'>IVM22) S IVM14="G" Q   ;Income <= GMT Threshold
  1.  . . S IVM14="C"
  1.  . S IVM14=IVM6
  1.  ;
  1.  ; - fields for means test, copay test and Long Term Care Test
  1.  S DATA(.14)=IVM4,DATA(.18)=IVM19,DATA(.23)=IVM11,DATA(2.05)=IVM8,DATA(.06)=DUZ,DATA(.07)=IVM1,DATA(2.02)=IVM13,DATA(2.03)=$$GETSTAT^DGMTH(IVM14,IVMTYPE),DATA(2.11)=IVM24
  1.  ;
  1.  I IVM7 S DATA(.08)=.5,DATA(.09)=$$NOW^XLFDT
  1.  ;
  1.  I 'IVM4 S DATA(.04)=IVM15,DATA(.15)=IVM18
  1.  ;
  1.  ; - means test fields
  1.  I IVMTYPE=1 D
  1.  . S DATA(.11)=IVM2,DATA(.12)=IVM17,DATA(.2)=IVM7,DATA(.24)=IVM3,DATA(.29)=IVM20,DATA(2.04)=IVM9,DATA(.1)=IVM5,DATA(2.01)=IVM12
  1.  . I 'IVM4 S DATA(.05)=IVM16
  1.  . S DATA(.16)=IVM10,DATA(.21)=IVM21,DATA(.27)=IVM22,DATA(2.09)=IVM23
  1.  ;
  1.  ; - Long Term Care fields
  1.  I IVMTYPE=4 D
  1.  . N DATE,TYPE
  1.  . ;set pointer to associated means test or RX copay test if there is one
  1.  . I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S DATE=$P(^TMP($J,"IVMCM","ZMT1"),HLFS,2),TYPE=1
  1.  . E  I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S DATE=$P(^TMP($J,"IVMCM","ZMT2"),HLFS,2),TYPE=2
  1.  . I $G(DATE) S DATA(2.08)=$P($$LST^DGMTU(DFN,DATE,TYPE),"^")
  1.  . S DATA(.11)=IVM2
  1.  . I 'IVM4 S DATA(.05)=IVM16
  1.  . K DATA(2.03)  ;test determined status is not used in LTC test
  1.  ;
  1.  I $G(IVMMTIEN) D
  1.  . ; Get record data to compare with HL7 Message data
  1.  . S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
  1.  . S NODE2=$G(^DGMT(408.31,IVMMTIEN,2))
  1.  . ;
  1.  . ; If Site Conducting Test is the same, get Completed By from record.t
  1.  . I $P(NODE2,"^",5)=IVM8 S DATA(.06)=$P(NODE0,"^",6)
  1.  . ;
  1.  . ; If there are Comments, copy them into new record
  1.  . I $O(^DGMT(408.31,IVMMTIEN,"C",0)) S DATA(50)="^DGMT(408.31,"_IVMMTIEN_",""C"")"
  1.  . ;
  1.  . I IVMTYPE=1 D
  1.  . . ; Hardship is YES in msg and record, and the Site Granting Hardship
  1.  . . ; is the same as the site receiving the msg, keep the record data
  1.  . . I IVM7,$P(NODE0,"^",20),IVM9=$P($$SITE^VASITE,"^",3) S DATA(.21)=$P(NODE0,"^",21),DATA(.22)=$P(NODE0,"^",22),DATA(.08)=$P(NODE0,"^",8),DATA(.09)=$P(NODE0,"^",9)
  1.  . . ;
  1.  . . ;hardship effective date should always be what is coming in in the ZMT segment
  1.  . . S DATA(2.01)=IVM12 ; IVM*2.0*193
  1.  . . ;
  1.  . . ; Hardship is YES in msg and record, and the Site Granting Hardship
  1.  . . ; is NOT the same in both the msg and record, keep the message data
  1.  . . I IVM7,$P(NODE0,"^",20),$P(NODE2,"^",4)'=IVM9 S DATA(.22)=DATA(.06)
  1.  . . ;
  1.  . . ; Hardship is YES in msg and NO in record, keep the message data
  1.  . . I IVM7,'$P(NODE0,"^",20) S DATA(.22)=DATA(.06)
  1.  . . ;
  1.  . . ; Hardship is set to delete in msg, delete the Hardship
  1.  . . I IVM12=HLQ!('IVM7&($P(NODE0,"^",20))) D
  1.  . . . ; DG*5.3*997;HM;  If hardship expr date (IVM26) not null, and if hardship eff date (IVM12) <= hardship expr date (IVM26) 
  1.  . . . ;  and hardship expr date (IVM26) is less than or equal to now (DT) then it is an expiration record, quit (do not clear data values)
  1.  . . . I IVM26'="",(IVM12<=IVM26)&(IVM26<=DT) Q
  1.  . . . S (DATA(.08),DATA(.09),DATA(.2),DATA(.21),DATA(.22),DATA(2.01),DATA(2.04),DATA(2.09))=""
  1.  . . . I $P(NODE0,"^",20) D BULL2^IVMCMB(DFN,$P(NODE2,"^"),$P(NODE2,"^",4))
  1.  . . ;
  1.  . . ; Hardship is NO in msg and in record, keep the message data
  1.  . . I 'IVM7,'$P(NODE0,"^",20) S DATA(.22)=""
  1.  . . ;
  1.  . . ; Notify site of hardship?
  1.  . . I IVM12'=HLQ,IVM7,((IVM12'=$P(NODE2,"^"))!('$P(NODE0,"^",20))) D BULL1^IVMCMB(DFN,IVM12,IVM9)
  1.  . . ;
  1.  . . ; Notify site to discontinue net-worth development?
  1.  . . I IVM11=3,$P(NODE0,"^",23)=1,$$GETCODE^DGMTH($P(NODE0,"^",3))="P" D BULL3^IVMCMB(DFN)
  1.  . . ;
  1.  . . ; Put message in comments field IVM*2.0*190
  1.  . . I IVM12'="",IVM12<IVM25 D
  1.  . . . K ^TMP($J,"IVMCM6","COMMENT")
  1.  . . . S ^TMP($J,"IVMCM6","COMMENT",1)="Received/Uploaded Test on "_$$FTIME^VALM1(IVM1)_" with data inconsistencies. "
  1.  . . . S ^TMP($J,"IVMCM6","COMMENT",2)=": Hardship Effective Date earlier than Means Test Date"
  1.  . . . D WP^DIE(408.31,""_DGMTI_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")")
  1.  . . . K DATA(50),^TMP($J,"IVMCM6","COMMENT") ;remove anything hanging around for comment field 50 so nothing gets overwritten
  1.  . . I IVM12'="",IVM12>=IVM25 D
  1.  . . . I $$CHKCMT(IVMMTIEN) S DATA(50)="" D RMVECMT(IVMMTIEN)
  1.  . . . I $D(^TMP($J,"IVMCM","NTE")) D
  1.  . . . . K ^TMP($J,"IVMCM6","COMMENT")
  1.  . . . . N IVMNTECT,IVMNTED
  1.  . . . . S IVMNTED=0
  1.  . . . . F IVMNTECT=1:1 D  Q:IVMNTED
  1.  . . . . . I '$D(^TMP($J,"IVMCM","NTE",IVMNTECT)) S IVMNTED=1 Q
  1.  . . . . . S ^TMP($J,"IVMCM6","COMMENT",IVMNTECT)=$P(^TMP($J,"IVMCM","NTE",IVMNTECT),"^")
  1.  . . . . D WP^DIE(408.31,""_DGMTI_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")")
  1.  . . . . K DATA(50),^TMP($J,"IVMCM6","COMMENT")
  1.  . . I IVM12="",$$CHKCMT(IVMMTIEN) D RMVECMT(IVMMTIEN)
  1.  ;
  1.  ;
  1.  ;determine status based on test-determined status and hardship
  1.  S CODE=IVM14
  1.  I IVMTYPE=1,DATA(.2) S CODE=IVM6
  1.  S DATA(.03)=$$GETSTAT^DGMTH(CODE,IVMTYPE)
  1.  ;
  1.  I $$UPD^DGENDBS(408.31,DGMTI,.DATA) D
  1.  . ; can't call MT Events protocol for Long Term Care Copay Exemption
  1.  . ; Tests as it triggers an IB and Enrollment update
  1.  . ; so manually call needed protocols to trigger audit, date stamp
  1.  . ; and transmission (if necessary)
  1.  . I IVMTYPE=4 D  Q
  1.  . . S:$G(DGMTACT)="" DGMTACT="ADD"
  1.  . . S DGMTP=$G(DGMTP)                                       ;IVM*2*84
  1.  . . S DGMTINF=1  ;Means Test Interactive/Non-interactive flag
  1.  . . D AFTER^DGMTEVT
  1.  . . D EN^DGMTAUD                   ;means test audit event
  1.  . . D ^IVMPMTE                     ;IVM means test event
  1.  . . D DATETIME^DGMTU4($G(DGMTI))   ;date stamp
  1.  . ;
  1.  . ; - call means test event driver if not future test
  1.  . I 'IVMFUTR D
  1.  . . D:(IVMTYPE=1) MTPRIME^DGMTU4(DGMTI)
  1.  . . D:(IVMTYPE=2) RXPRIME^DGMTU4(DGMTI)
  1.  . . S CODE=$$GETCODE^DGMTH($P($G(^DGMT(408.31,DGMTI,0)),"^",3))
  1.  . E  D
  1.  . . ;enter to list of future tests kept in the IVM Patient file
  1.  . . D ADDFUTR^IVMPLOG2(DGMTI)
  1.  . . ;also, if HEC changed the test to a future date, there could be
  1.  . . ;a test on file for the same income year marked as primary
  1.  . . I $G(IVMMTIEN),$P(NODE2,"^",5)=IVM8 D
  1.  . . . N DATA,ERROR,DGMTI,DGMTACT,DGMTYPT,DGMTA
  1.  . . . S DATA(2)=0
  1.  . . . I $$UPD^DGENDBS(408.31,IVMMTIEN,.DATA,.ERROR)
  1.  . . . ; if the test being replaced by the uploaded future test
  1.  . . . ; becomes non-primary and the site conducted both tests
  1.  . . . ; then call Means Test event driver (non interactively)
  1.  . . . S DGMTACT="EDT",DGMTI=IVMMTIEN,DGMTYPT=IVMTYPE,DGMTINF=1
  1.  . . . D AFTER^DGMTEVT
  1.  . . . D EN^DGMTEVT
  1.  . . . D
  1.  . . . . N DGMSGF,DGADDF
  1.  . . . . S DGMSGF=1,DGADDF=0
  1.  . . . . D EN^DGMTR
  1.  . D:OK2SND TRNSMT
  1.  ;
  1.  ;
  1. MTBULL ; Build results array
  1.  D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"Future Test",1:"New Test"),$G(IVMMTDT),$S($G(IVMMTIEN):$$GETCODE^DGMTH($P($G(^DGMT(408.31,IVMMTIEN,0)),"^",3)),1:""),CODE)
  1.  ;
  1. CLEANUP ; cleanup
  1.  K DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB,IVMBU45,IVMOP,IVMOP1
  1.  K IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVM8,IVM9,IVM10,IVM11,IVM12,IVM13,IVM14,IVMCAT,IVMCEA,IVMCEB,IVMMTA,IVM15,IVM16,IVM17,IVM18,IVM19,IVM20,IVM21
  1.  K IVM22,IVM23,IVM24,IVM25,IVM26 ;IVM*2.0*190 IVM*2.0*193
  1.  Q
  1.  ;
  1. CHKCMT(MTIEN) ; CHECK FOR HARDSHIP COMMENT IVM*2.0*190
  1.  ; DBIA 968     NAME: DBIA968               FILE: 408.31                 ROOT: DGMT(408.31,
  1.  N CNT,RET,COMMENT,DIC,DR,DA
  1.  S DIC=408.31,DR="50",DA=MTIEN
  1.  S DR(408.311)=".01",DA(408.311)=1
  1.  D EN^DIQ1
  1.  S CNT=0,RET=0
  1.  F  S CNT=$O(^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT)) Q:CNT=""  D  Q:RET
  1.   .S COMMENT=^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT)
  1.   .I COMMENT["Hardship Effective Date earlier than Means Test Date" S RET=1
  1.  Q RET
  1.  ;
  1. RMVECMT(MTIEN) ; REMOVE COMMENTS NOT NEEDED IVM*2.0*190 
  1.  ; DBIA 968     NAME:DBIA968                FILE: 408.31                 ROOT: DGMT(408.31,
  1.  N CNT,RET,COMMENT,DIC,DR,DA,IVMFNDC1,IVMFNDC2,IVMLNCT
  1.  S DIC=408.31,DR="50",DA=MTIEN,IVMFNDC1=0,IVMFNDC2=0,IVMLNCT=0
  1.  S DR(408.311)=".01",DA(408.311)=1
  1.  D EN^DIQ1
  1.  S CNT=0,RET=0
  1.  F  S CNT=$O(^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT)) Q:CNT=""  D  Q:RET
  1.  .S COMMENT=^UTILITY("DIQ1",$J,408.31,MTIEN,50,CNT),(IVMFNDC1,IVMFNDC2)=0
  1.  .I COMMENT["Received/Uploaded Test on"&(COMMENT["with data inconsistencies") S IVMFNDC1=1
  1.  .I COMMENT["Hardship Effective Date earlier than Means Test Date" S IVMFNDC2=1
  1.  .I 'IVMFNDC1,'IVMFNDC2 S IVMLNCT=IVMLNCT+1,^TMP($J,"IVMCM6","COMMENT",IVMLNCT)=COMMENT
  1.  I IVMLNCT>0 D WP^DIE(408.31,""_MTIEN_",",50,"K","^TMP($J,""IVMCM6"",""COMMENT"")") K ^TMP($J,"IVMCM6","COMMENT")
  1.  Q
  1.  ;
  1. OPEN ; open case record for uploaded test
  1.  S IVMOP="",IVMOP=$O(^IVM(301.5,"AYR",DGLY,DFN,IVMOP)) I 'IVMOP D OPEN1 Q
  1.  S IVMOP1=$G(^IVM(301.5,IVMOP,0)) I 'IVMOP1 D OPEN1 Q
  1.  I $P(IVMOP1,"^",4)=1 S DA=+IVMOP D  Q
  1.  . S DIE="^IVM(301.5,",DR=".03////1;.04////0"
  1.  . D OPEN2
  1.  Q
  1. OPEN1 K DD,DO
  1.  S DIC="^IVM(301.5,",DIC(0)="LMNZ",X=DFN,DLAYGO=301.5
  1.  D FILE^DICN Q:Y'>0  S DA=+Y
  1.  S DIE="^IVM(301.5,",DR=".02////^S X=DGLY;.03////1;.04////0"
  1. OPEN2 D ^DIE K DD,DO,DIC,DLAYGO,X,Y,DIE,DR
  1.  Q
  1.  ;
  1. MTDRIVER ; call means test event driver
  1.  ; dgmtact
  1.  ; adj  adjudicated mt
  1.  ; cat  hardship mt
  1.  ; add  new mt or copay
  1.  ; edit corrected mt or copay
  1.  ;         
  1.  N IVMDA,IVMDT,IVMFLG,IVMMTDT,IVMNEW
  1.  S DGMTACT=$S($G(IVMHADJ)=1:"ADJ",$G(IVMHADJ)=2:"CAT",'$G(DGMTP):"ADD",1:"EDT")
  1.  D AFTER^DGMTEVT
  1.  S DGMTINF=1 ; non-interactive flag
  1.  D EN^DGMTEVT
  1.  Q
  1.  ;
  1. CHKTST ; Verify if the incoming Income Test requires a Z07 transmission.
  1.  ;
  1.  N MTREC,REC01,ZMTSEG
  1.  S OK2SND=0
  1.  S MTREC=$G(^DGMT(408.31,DGMTI,0))
  1.  Q:'$D(^DGMT(408.31,DGMTI,0))
  1.  ; Check if the Source of the Test is DCD
  1.  S ZMTSEG=$G(^TMP($J,"IVMCM","ZMT"_IVMTYPE))
  1.  Q:$P($G(^DG(408.34,+$P(ZMTSEG,U,18),0)),U)'="DCD"
  1.  ;Check if the DCD software has been installed
  1.  Q:'$$VERSION^XPDUTL("IVMC")
  1.  ;
  1.  ; If the source of the test is DCD, and the site receiving the test
  1.  ; is a DCD site, set the record to transmit.
  1.  S OK2SND=1
  1.  Q
  1.  ;
  1. TRNSMT ; Set the record to transmit due to DCD Criteria
  1.  N REC01,DCDDATA,DCDIEN,EVENTS,ERROR
  1.  S REC01=$O(^IVM(301.5,"AYR",DGLY,DFN,""))
  1.  S DCDDATA(.04)=0,DCDIEN=REC01
  1.  I $$UPD^DGENDBS(301.5,DCDIEN,.DCDDATA,.ERROR)
  1.  S EVENTS("DCD")=1
  1.  I $$SETSTAT^IVMPLOG(REC01,.EVENTS)
  1.  ;
  1.  Q