DGMTCOR ;ALB/CAW,SCG,LBD,TMK,HM,DSB - Check Copay Test Requirements;07/28/08
;;5.3;Registration;**21,45,182,290,305,330,344,495,564,773,840,858,972,993**;Aug 13, 1993;Build 92
;
;A patient may apply for a copay test under the following conditions:
; - Applicant is a veteran
; - Applicant's primary or other eligibility does NOT contain
; - Service Connected 50% to 100% or
; - Aid and Attendance or
; - Housebound or
; - VA Pension
; - Catastrophically Disabled
; - Medal of Honor Recipient
; - Primary Eligibility is NSC
; - who has NOT been means tested
; - who claims exposure to agent orange or ionizing radiation
; - who is eligible for medicaid
; - Applicants who have answered 'no' to Receiving A&A, HB, or Pension
; - Applicants who have previously qualified and applied for a copay
; exemption, still qualify and have NOT been copay tested in the
; past year
; - Applicants who are not currently a DOM patient or inpatient
; (they are temporarily exempt from copay testing) DG*5.3*290
; - Applicants who do not have POW eligibility (DG*5.3*564 - HVE III)
; - Applicants who do not meet criteria for Unemployable:
; Unemployable="Y", SC%>0, not receiving A&A, HB or Pension, and
; Total VA Check Amount>0 (DG*5.3*564 - HVE III)
; - Applicant is not Registration only DG*5.3*993
;
; Input -- DFN Patient IEN
; DGADDF Means Test Add Flag (optional)
; DGNOIVMUPD Do Not Update IVM Copay Test Flag (optional)
; Output -- DGMTCOR Copay Test Flag
; (1 if eligible and 0 if not eligible)
;
;
EN ;
Q:$G(VAFCA08)=1
N DGMTI,DGMTYPT,DGMDOD
D ON^DGMTCOU G:'Y ENQ
S DGRGAUTO=1 ;possible change in cp status w/o call to cp event driver
D CHK
;
Q:($G(DGWRT)=8)!($G(DGWRT)=9) ;brm;quit if inpatient or dom;DG*5.3*290
S IVMZ10F=+$G(IVMZ10F)
I 'DGMTCOR,'$G(DGADDF),'$G(DGMDOD),'IVMZ10F D NLA
I DGMTCOR,'$G(DGADDF),'$G(DGMDOD) D INC
I DGRGAUTO&'$G(DGADDF) D QREGAUTO ;if cp event driver not fired off & NOT a new means test
;
ENQ Q
;
CHK N STATUS,DGELIG,DGE,DGI,DGNODE,DGMDOD,DGMTDT,DGMTI,DGMTL
S DGMTCOR=1,DGMT="",DGMTYPT=2
I $P($G(^DPT(DFN,"VET")),U,1)'="Y" S DGMTCOR=0,DGWRT=1 G CHKQ ;NON-VET
;Added with DG*5.3*344
S DGMTL=$$LST^DGMTU(DFN),DGMTI=+DGMTL,DGMTDT=$P(DGMTL,U,2)
S DGMDOD=$P($G(^DPT(DFN,.35)),U)
I 'DGMTI,$G(DGMDOD) S DGMTCOR=0 Q
I DGMDOD,(DGMTCOR),(DGMTDT>(DGMDOD-1)) S DGMTCOR=0 G CHKQ
;
I '$P($G(^DPT(DFN,.36)),U) S DGMTCOR=0,DGWRT=2 G CHKQ ;NO PRIM ELIG
I +$G(DGMDOD) S DGNOCOPF=1
;
;This doesn't work! The "AEL" x-ref not there when changing the primary
;eligibility! Problem with order that the cross-references are called
;in, DGMTR is called before the "AEL" x-ref is set!
;F S DGMTI=$O(^DPT("AEL",DFN,DGMTI)) Q:'DGMTI S DGMTE=$P($G(^DIC(8,DGMTI,0)),U,9) I "^1^2^4^15^"[("^"_DGMTE_"^") S DGMTCOR=0,DGWRT=3 G CHKQ
;
;
S DGI=$P($G(^DPT(DFN,.36)),"^"),DGELIG=U_$P($G(^DIC(8,+DGI,0)),U,9)_U
S DGI=0 F S DGI=$O(^DPT(DFN,"E",DGI)) Q:'DGI S DGE=$P($G(^DPT(DFN,"E",DGI,0)),U),DGELIG=DGELIG_$P($G(^DIC(8,+DGE,0)),U,9)_U
I (DGELIG["^1^") S DGMTCOR=0,DGWRT=3 G CHKQ ;SC 50-100%
;Begin DG*5.3*993 Registration only
I $G(DGENRYN)=0 S DGMTCOR=0,DGWRT=14 G CHKQ
I '$G(DGENRYN) S STATUS=$$STATUS^DGENA(DFN) I STATUS=25 S DGMTCOR=0,DGWRT=14 G CHKQ
;End DG*5.3*993
F DGI=.3,.362,.39,.52,.54 S DGNODE(DGI)=$G(^DPT(DFN,DGI)) ;DG*5.3*840; added MOH indicator field on loop DG*5.3*972 HM
I $P(DGNODE(.362),U,12)["Y"!(DGELIG["^2^") S DGMTCOR=0,DGWRT=5 G CHKQ ;A&A
I $P(DGNODE(.362),U,13)["Y"!(DGELIG["^15^") S DGMTCOR=0,DGWRT=6 G CHKQ ;HB
I $P(DGNODE(.362),U,14)["Y"!(DGELIG["^4^") S DGMTCOR=0,DGWRT=7 G CHKQ ;PENSION
I $P(DGNODE(.52),U,5)["Y"!(DGELIG["^18^") S DGMTCOR=0,DGWRT=10 G CHKQ ;POW (DG*5.3*564)
I $P(DGNODE(.39),U,6)["Y"!(DGELIG["^21^") S DGMTCOR=0,DGWRT=12 G CHKQ ;CD (DG*5.3*840
I $P(DGNODE(.3),U,5)["Y"&($P(DGNODE(.3),U,2)>0)&($P(DGNODE(.362),U,20)>0) S DGMTCOR=0,DGWRT=11 G CHKQ ;UNEMPLOYABLE (DG*5.3*564)
I $P(DGNODE(.54),U,1)["Y" S DGMTCOR=0,DGWRT=13 G CHKQ ;MOH (DG*5.3*972);HM
;brm added next 3 lines for DG*5.3*290
N DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR,NOW
D DOM^DGMTR I $G(DGDOM) S DGMTCOR=0,DGRGAUTO=0,DGWRT=8 Q ;DOM
D IN5^VADPT I $G(VAIP(1))'="" S DGMTCOR=0,DGRGAUTO=0,DGWRT=9 Q ;INP
;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
I DGMTI,'$$OLDMTPF^DGMTU4(DGMTDT) S STATUS=$P($G(^DGMT(408.31,+DGMTI,0)),U,3) I STATUS'="3" S DGMTCOR=0,DGWRT=4 G CHKQ
CHKQ Q
;
NLA ; Change Status to NO LONGER APPLICABLE - if appropriate
;
N DGCS,DGMTI,DGMT0,DGINI,DGINR,DGVAL,DGFL,DGFLD,DGIEN,DGMTACT,TDATE
S DGMTI=+$$LST^DGMTU(DFN,"",2) Q:'DGMTI!($P($G(^DGMT(408.31,DGMTI,0)),U,3)=10)
; Do not allow update of IVM test by site
I $G(DGNOIVMUPD),$$IVMCVT^DGMTCOR(DGMTI) D Q ;Check if converted IVM MT
. ;I '$G(DGMSGF),$G(DGNOIVMUPD)<2 W !,"IVM RX COPAY TEST EXISTS, BUT VISTA CALCULATES 'NO LONGER APPLICABLE'",!,"CONTACT IVM TO CLEAR UP THE DISCREPANCY - YOU CANNOT UPDATE AN IVM TEST"
. S DGNOIVMUPD=2 ; Prevent double printing of the message
S DGMT0=$G(^DGMT(408.31,DGMTI,0)) Q:'DGMT0
S DGCS=$P(DGMT0,U,3)
S TDATE=+DGMT0
S DGMTACT="STA" D PRIOR^DGMTEVT
;
D SAVESTAT^DGMTU4(DGMTI)
;
S DGFL=408.31,DGIEN=DGMTI
S DGFLD=.03 I DGCS]"" S DGVAL=DGCS D KILL^DGMTR
S DGVAL=10,$P(^DGMT(408.31,DGMTI,0),"^",3)=DGVAL D SET^DGMTR
S DGFLD=.17,DGVAL=DT,$P(^DGMT(408.31,DGMTI,0),"^",17)=DT D SET^DGMTR
W:'$G(DGMTMSG)&'$D(ZTQUEUED) !,"COPAY TEST NO LONGER APPLICABLE"
D GETINCOM^DGMTU4(DFN,TDATE)
S DGMTYPT=2 D QUE^DGMTR
S DGRGAUTO=0
NLAQ Q
;
INC ;Update copay status to 'INCOMPLETE' if applicable OR restore completed test
N DGMTACT,DGMTI,DGFL,DGFLD,DGIEN,DGMTP,DGVAL,DGMT0,AUTOCOMP,ERROR
S AUTOCOMP=0
S DGMTI=+$$LST^DGMTU(DFN,"",2)
D
.Q:'DGMTI
.I ($P($G(^DGMT(408.31,DGMTI,0)),U,3)'=10) S AUTOCOMP=1 Q
.S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGCS=$P(DGMT0,U,3)
.Q:'DGMT0
.S DGMTACT="STA" D PRIOR^DGMTEVT
.S AUTOCOMP=$$AUTOCOMP^DGMTR(DGMTI)
.W:'AUTOCOMP&'$G(DGMTMSG)&'$D(ZTQUEUED) !,"COPAY EXEMPTION TEST UPDATED TO INCOMPLETE"
.W:AUTOCOMP&'$G(DGMTMSG)&'$D(ZTQUEUED) !,"COPAY EXEMPTION TEST UPDATED TO ",$$GETNAME^DGMTH($P($G(^DGMT(408.31,DGMTI,0)),"^",3))
.S DGMTYPT=2 D QUE^DGMTR
.S DGRGAUTO=0
;
I $G(IVMZ10)'="UPLOAD IN PROGRESS",$G(DGQSENT)'=1,'AUTOCOMP,'$$OPEN^IVMCQ2(DFN),'$$SENT^IVMCQ2(DFN) D QRYQUE2^IVMCQ2(DFN,$G(DUZ),0,$G(XQY)) S DGQSENT=1 I '$D(ZTQUEUED),'$G(DGMSGF) W !!,"Financial query queued to be sent to HEC..."
;
INCQ Q
;
QREGAUTO ;Queues off test done by IB recalculating CP status
; Input: DFN
; Action: Possible update of Copay Status
;
Q:'$D(^IBA(354.1,"APIDT",DFN,1)) ;No action if no status on file
S ZTDESC="CHECK PATIENT FILE CHANGES VS CP STATUS",ZTDTH=$H,ZTRTN="REGAUTO^IBARXEU5",ZTSAVE("DFN")="",ZTIO=""
D ^%ZTLOAD
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
;
IVMCVT(IVMTIEN) ; Check for a converted IVM Means Test
; Input IVMTIEN - MT IEN to check
; Return 1 - if converted MT
; 0 - if not a converted MT
;
N FLAG,IVMAR
S FLAG=0
I '$G(IVMTIEN) G IVMQ
D GETS^DIQ(408.31,IVMTIEN,".23;.25","E","IVMAR")
; To identify an IVM converted test in the ANNUAL MEANS TEST, #408.31, if the Source of Test (#.23)
; is equal to 'IVM' OR the Date IVM Verified MT Completed (#.25) is populated, then the test should
; be considered a converted test.
I IVMAR(408.31,IVMTIEN_",",.23,"E")="IVM" S FLAG=1 G IVMQ
I IVMAR(408.31,IVMTIEN_",",.25,"E")]"" S FLAG=1 G IVMQ
IVMQ ;
Q FLAG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTCOR 7673 printed Apr 09, 2024@22:03:34 Page 2
DGMTCOR ;ALB/CAW,SCG,LBD,TMK,HM,DSB - Check Copay Test Requirements;07/28/08
+1 ;;5.3;Registration;**21,45,182,290,305,330,344,495,564,773,840,858,972,993**;Aug 13, 1993;Build 92
+2 ;
+3 ;A patient may apply for a copay test under the following conditions:
+4 ; - Applicant is a veteran
+5 ; - Applicant's primary or other eligibility does NOT contain
+6 ; - Service Connected 50% to 100% or
+7 ; - Aid and Attendance or
+8 ; - Housebound or
+9 ; - VA Pension
+10 ; - Catastrophically Disabled
+11 ; - Medal of Honor Recipient
+12 ; - Primary Eligibility is NSC
+13 ; - who has NOT been means tested
+14 ; - who claims exposure to agent orange or ionizing radiation
+15 ; - who is eligible for medicaid
+16 ; - Applicants who have answered 'no' to Receiving A&A, HB, or Pension
+17 ; - Applicants who have previously qualified and applied for a copay
+18 ; exemption, still qualify and have NOT been copay tested in the
+19 ; past year
+20 ; - Applicants who are not currently a DOM patient or inpatient
+21 ; (they are temporarily exempt from copay testing) DG*5.3*290
+22 ; - Applicants who do not have POW eligibility (DG*5.3*564 - HVE III)
+23 ; - Applicants who do not meet criteria for Unemployable:
+24 ; Unemployable="Y", SC%>0, not receiving A&A, HB or Pension, and
+25 ; Total VA Check Amount>0 (DG*5.3*564 - HVE III)
+26 ; - Applicant is not Registration only DG*5.3*993
+27 ;
+28 ; Input -- DFN Patient IEN
+29 ; DGADDF Means Test Add Flag (optional)
+30 ; DGNOIVMUPD Do Not Update IVM Copay Test Flag (optional)
+31 ; Output -- DGMTCOR Copay Test Flag
+32 ; (1 if eligible and 0 if not eligible)
+33 ;
+34 ;
EN ;
+1 if $GET(VAFCA08)=1
QUIT
+2 NEW DGMTI,DGMTYPT,DGMDOD
+3 DO ON^DGMTCOU
if 'Y
GOTO ENQ
+4 ;possible change in cp status w/o call to cp event driver
SET DGRGAUTO=1
+5 DO CHK
+6 ;
+7 ;brm;quit if inpatient or dom;DG*5.3*290
if ($GET(DGWRT)=8)!($GET(DGWRT)=9)
QUIT
+8 SET IVMZ10F=+$GET(IVMZ10F)
+9 IF 'DGMTCOR
IF '$GET(DGADDF)
IF '$GET(DGMDOD)
IF 'IVMZ10F
DO NLA
+10 IF DGMTCOR
IF '$GET(DGADDF)
IF '$GET(DGMDOD)
DO INC
+11 ;if cp event driver not fired off & NOT a new means test
IF DGRGAUTO&'$GET(DGADDF)
DO QREGAUTO
+12 ;
ENQ QUIT
+1 ;
CHK NEW STATUS,DGELIG,DGE,DGI,DGNODE,DGMDOD,DGMTDT,DGMTI,DGMTL
+1 SET DGMTCOR=1
SET DGMT=""
SET DGMTYPT=2
+2 ;NON-VET
IF $PIECE($GET(^DPT(DFN,"VET")),U,1)'="Y"
SET DGMTCOR=0
SET DGWRT=1
GOTO CHKQ
+3 ;Added with DG*5.3*344
+4 SET DGMTL=$$LST^DGMTU(DFN)
SET DGMTI=+DGMTL
SET DGMTDT=$PIECE(DGMTL,U,2)
+5 SET DGMDOD=$PIECE($GET(^DPT(DFN,.35)),U)
+6 IF 'DGMTI
IF $GET(DGMDOD)
SET DGMTCOR=0
QUIT
+7 IF DGMDOD
IF (DGMTCOR)
IF (DGMTDT>(DGMDOD-1))
SET DGMTCOR=0
GOTO CHKQ
+8 ;
+9 ;NO PRIM ELIG
IF '$PIECE($GET(^DPT(DFN,.36)),U)
SET DGMTCOR=0
SET DGWRT=2
GOTO CHKQ
+10 IF +$GET(DGMDOD)
SET DGNOCOPF=1
+11 ;
+12 ;This doesn't work! The "AEL" x-ref not there when changing the primary
+13 ;eligibility! Problem with order that the cross-references are called
+14 ;in, DGMTR is called before the "AEL" x-ref is set!
+15 ;F S DGMTI=$O(^DPT("AEL",DFN,DGMTI)) Q:'DGMTI S DGMTE=$P($G(^DIC(8,DGMTI,0)),U,9) I "^1^2^4^15^"[("^"_DGMTE_"^") S DGMTCOR=0,DGWRT=3 G CHKQ
+16 ;
+17 ;
+18 SET DGI=$PIECE($GET(^DPT(DFN,.36)),"^")
SET DGELIG=U_$PIECE($GET(^DIC(8,+DGI,0)),U,9)_U
+19 SET DGI=0
FOR
SET DGI=$ORDER(^DPT(DFN,"E",DGI))
if 'DGI
QUIT
SET DGE=$PIECE($GET(^DPT(DFN,"E",DGI,0)),U)
SET DGELIG=DGELIG_$PIECE($GET(^DIC(8,+DGE,0)),U,9)_U
+20 ;SC 50-100%
IF (DGELIG["^1^")
SET DGMTCOR=0
SET DGWRT=3
GOTO CHKQ
+21 ;Begin DG*5.3*993 Registration only
+22 IF $GET(DGENRYN)=0
SET DGMTCOR=0
SET DGWRT=14
GOTO CHKQ
+23 IF '$GET(DGENRYN)
SET STATUS=$$STATUS^DGENA(DFN)
IF STATUS=25
SET DGMTCOR=0
SET DGWRT=14
GOTO CHKQ
+24 ;End DG*5.3*993
+25 ;DG*5.3*840; added MOH indicator field on loop DG*5.3*972 HM
FOR DGI=.3,.362,.39,.52,.54
SET DGNODE(DGI)=$GET(^DPT(DFN,DGI))
+26 ;A&A
IF $PIECE(DGNODE(.362),U,12)["Y"!(DGELIG["^2^")
SET DGMTCOR=0
SET DGWRT=5
GOTO CHKQ
+27 ;HB
IF $PIECE(DGNODE(.362),U,13)["Y"!(DGELIG["^15^")
SET DGMTCOR=0
SET DGWRT=6
GOTO CHKQ
+28 ;PENSION
IF $PIECE(DGNODE(.362),U,14)["Y"!(DGELIG["^4^")
SET DGMTCOR=0
SET DGWRT=7
GOTO CHKQ
+29 ;POW (DG*5.3*564)
IF $PIECE(DGNODE(.52),U,5)["Y"!(DGELIG["^18^")
SET DGMTCOR=0
SET DGWRT=10
GOTO CHKQ
+30 ;CD (DG*5.3*840
IF $PIECE(DGNODE(.39),U,6)["Y"!(DGELIG["^21^")
SET DGMTCOR=0
SET DGWRT=12
GOTO CHKQ
+31 ;UNEMPLOYABLE (DG*5.3*564)
IF $PIECE(DGNODE(.3),U,5)["Y"&($PIECE(DGNODE(.3),U,2)>0)&($PIECE(DGNODE(.362),U,20)>0)
SET DGMTCOR=0
SET DGWRT=11
GOTO CHKQ
+32 ;MOH (DG*5.3*972);HM
IF $PIECE(DGNODE(.54),U,1)["Y"
SET DGMTCOR=0
SET DGWRT=13
GOTO CHKQ
+33 ;brm added next 3 lines for DG*5.3*290
+34 NEW DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR,NOW
+35 ;DOM
DO DOM^DGMTR
IF $GET(DGDOM)
SET DGMTCOR=0
SET DGRGAUTO=0
SET DGWRT=8
QUIT
+36 ;INP
DO IN5^VADPT
IF $GET(VAIP(1))'=""
SET DGMTCOR=0
SET DGRGAUTO=0
SET DGWRT=9
QUIT
+37 ;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+38 IF DGMTI
IF '$$OLDMTPF^DGMTU4(DGMTDT)
SET STATUS=$PIECE($GET(^DGMT(408.31,+DGMTI,0)),U,3)
IF STATUS'="3"
SET DGMTCOR=0
SET DGWRT=4
GOTO CHKQ
CHKQ QUIT
+1 ;
NLA ; Change Status to NO LONGER APPLICABLE - if appropriate
+1 ;
+2 NEW DGCS,DGMTI,DGMT0,DGINI,DGINR,DGVAL,DGFL,DGFLD,DGIEN,DGMTACT,TDATE
+3 SET DGMTI=+$$LST^DGMTU(DFN,"",2)
if 'DGMTI!($PIECE($GET(^DGMT(408.31,DGMTI,0)),U,3)=10)
QUIT
+4 ; Do not allow update of IVM test by site
+5 ;Check if converted IVM MT
IF $GET(DGNOIVMUPD)
IF $$IVMCVT^DGMTCOR(DGMTI)
Begin DoDot:1
+6 ;I '$G(DGMSGF),$G(DGNOIVMUPD)<2 W !,"IVM RX COPAY TEST EXISTS, BUT VISTA CALCULATES 'NO LONGER APPLICABLE'",!,"CONTACT IVM TO CLEAR UP THE DISCREPANCY - YOU CANNOT UPDATE AN IVM TEST"
+7 ; Prevent double printing of the message
SET DGNOIVMUPD=2
End DoDot:1
QUIT
+8 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
if 'DGMT0
QUIT
+9 SET DGCS=$PIECE(DGMT0,U,3)
+10 SET TDATE=+DGMT0
+11 SET DGMTACT="STA"
DO PRIOR^DGMTEVT
+12 ;
+13 DO SAVESTAT^DGMTU4(DGMTI)
+14 ;
+15 SET DGFL=408.31
SET DGIEN=DGMTI
+16 SET DGFLD=.03
IF DGCS]""
SET DGVAL=DGCS
DO KILL^DGMTR
+17 SET DGVAL=10
SET $PIECE(^DGMT(408.31,DGMTI,0),"^",3)=DGVAL
DO SET^DGMTR
+18 SET DGFLD=.17
SET DGVAL=DT
SET $PIECE(^DGMT(408.31,DGMTI,0),"^",17)=DT
DO SET^DGMTR
+19 if '$GET(DGMTMSG)&'$DATA(ZTQUEUED)
WRITE !,"COPAY TEST NO LONGER APPLICABLE"
+20 DO GETINCOM^DGMTU4(DFN,TDATE)
+21 SET DGMTYPT=2
DO QUE^DGMTR
+22 SET DGRGAUTO=0
NLAQ QUIT
+1 ;
INC ;Update copay status to 'INCOMPLETE' if applicable OR restore completed test
+1 NEW DGMTACT,DGMTI,DGFL,DGFLD,DGIEN,DGMTP,DGVAL,DGMT0,AUTOCOMP,ERROR
+2 SET AUTOCOMP=0
+3 SET DGMTI=+$$LST^DGMTU(DFN,"",2)
+4 Begin DoDot:1
+5 if 'DGMTI
QUIT
+6 IF ($PIECE($GET(^DGMT(408.31,DGMTI,0)),U,3)'=10)
SET AUTOCOMP=1
QUIT
+7 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
SET DGCS=$PIECE(DGMT0,U,3)
+8 if 'DGMT0
QUIT
+9 SET DGMTACT="STA"
DO PRIOR^DGMTEVT
+10 SET AUTOCOMP=$$AUTOCOMP^DGMTR(DGMTI)
+11 if 'AUTOCOMP&'$GET(DGMTMSG)&'$DATA(ZTQUEUED)
WRITE !,"COPAY EXEMPTION TEST UPDATED TO INCOMPLETE"
+12 if AUTOCOMP&'$GET(DGMTMSG)&'$DATA(ZTQUEUED)
WRITE !,"COPAY EXEMPTION TEST UPDATED TO ",$$GETNAME^DGMTH($PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",3))
+13 SET DGMTYPT=2
DO QUE^DGMTR
+14 SET DGRGAUTO=0
End DoDot:1
+15 ;
+16 IF $GET(IVMZ10)'="UPLOAD IN PROGRESS"
IF $GET(DGQSENT)'=1
IF 'AUTOCOMP
IF '$$OPEN^IVMCQ2(DFN)
IF '$$SENT^IVMCQ2(DFN)
DO QRYQUE2^IVMCQ2(DFN,$GET(DUZ),0,$GET(XQY))
SET DGQSENT=1
IF '$DATA(ZTQUEUED)
IF '$GET(DGMSGF)
WRITE !!,"Financial query queued to be sent to HEC..."
+17 ;
INCQ QUIT
+1 ;
QREGAUTO ;Queues off test done by IB recalculating CP status
+1 ; Input: DFN
+2 ; Action: Possible update of Copay Status
+3 ;
+4 ;No action if no status on file
if '$DATA(^IBA(354.1,"APIDT",DFN,1))
QUIT
+5 SET ZTDESC="CHECK PATIENT FILE CHANGES VS CP STATUS"
SET ZTDTH=$HOROLOG
SET ZTRTN="REGAUTO^IBARXEU5"
SET ZTSAVE("DFN")=""
SET ZTIO=""
+6 DO ^%ZTLOAD
+7 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+8 QUIT
+9 ;
IVMCVT(IVMTIEN) ; Check for a converted IVM Means Test
+1 ; Input IVMTIEN - MT IEN to check
+2 ; Return 1 - if converted MT
+3 ; 0 - if not a converted MT
+4 ;
+5 NEW FLAG,IVMAR
+6 SET FLAG=0
+7 IF '$GET(IVMTIEN)
GOTO IVMQ
+8 DO GETS^DIQ(408.31,IVMTIEN,".23;.25","E","IVMAR")
+9 ; To identify an IVM converted test in the ANNUAL MEANS TEST, #408.31, if the Source of Test (#.23)
+10 ; is equal to 'IVM' OR the Date IVM Verified MT Completed (#.25) is populated, then the test should
+11 ; be considered a converted test.
+12 IF IVMAR(408.31,IVMTIEN_",",.23,"E")="IVM"
SET FLAG=1
GOTO IVMQ
+13 IF IVMAR(408.31,IVMTIEN_",",.25,"E")]""
SET FLAG=1
GOTO IVMQ
IVMQ ;
+1 QUIT FLAG
