- 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 Jan 18, 2025@03:45:20 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