IVMCQ ;ALB/KCL/AEG/GAH,BDB - API FOR FINANCIAL QUERIES ; 28-N0V-06
;;2.0;INCOME VERIFICATION MATCH;**17,30,55,120,154**;21-OCT-94;Build 28
;
;
OPT ; Entry point for stand-alone financial query option.
;
N IVMQUIT
W !!,"This option allows queries to be sent to the Health Eligibility"
W !,"Center (HEC) for patients that require updated income information."
S IVMQUIT=0 F D EACH1 Q:IVMQUIT
Q
;
EACH1 ; Description: Used to send a financial query for each patient selected. from stand-alone option.
;
N DFN,IVMERROR,IVMOK,IVMOUT,IVMQUE,IVMREPLY,Y
S DIC="^DPT(",DIC(0)="AEMQ"
W ! D ^DIC K DIC S DFN=+Y I Y<1 S IVMQUIT=1 G EACH1Q
;
; does patient need a financial query?
I '$$NEED(DFN,1,.IVMERROR) W !!,"A financial query can not be sent for this patient!" W !,IVMERROR G EACH1Q
;
; ask if okay to send query?
I '$$ASK(.IVMOK)!($G(IVMOK)) G EACH1Q
;
; notify when a reply to query is received?
S IVMREPLY=$$NOTIFY(.IVMOUT)
I $G(IVMOUT) G EACH1Q
;
; send query for patient, else write error
I $$QUERY^IVMCQ1(DFN,$G(DUZ),$G(IVMREPLY),$G(XQY),.IVMERROR,1) W !!,"Financial query sent ..."
E D
.W !!,"Failure to send query: ",IVMERROR
;
EACH1Q Q
;
;
REG(DFN) ; Entry point to automatically send a query to HEC for updated financial information.
;
; This entry point is called from hooks in registration:
; - Register a Patient option (DGREG)
; - Load/Edit Patient Data option (DG10)
;
; Input:
; DFN - IEN of patient record in PATIENT file
;
; Output: none
;
I '$G(DFN) G REGQ
I '$$NEED(DFN) G REGQ
I $$QUERY^IVMCQ1(DFN,$G(DUZ),0,$G(XQY),,1) W !!,"Financial query sent ..."
REGQ Q
;
;
APPT ; Entry point for IVM SEND FINANCIAL QUERY protocol.
;
; Input:
; SDAMEVT - IEN of record in APPOINTMENT TRANSACTION TYPE file.
; (Transaction type that can occur against an appointment)
; SDATA - Array passed from the [SDAM APPOINTMENT EVENTS]
; extended protocol. 2nd piece of SDATA is IEN of patient
; record in PATIENT file.
;
; Output: none
;
N DFN
;
; quit if supported Sched vars not defined
I '$D(SDAMEVT) G APPTQ
S DFN=$P($G(SDATA),"^",2)
I 'DFN G APPTQ
;
; quit if transaction type not (make appt, check-in, check-out)
I SDAMEVT'=1,(SDAMEVT'=4),(SDAMEVT'=5) G APPTQ
;
; does patient need query sent?
I '$$NEED(DFN,1) G APPTQ
;
; send query for patient
I $$QUERY^IVMCQ1(DFN,$G(DUZ),0,$G(XQY),,1)
;
APPTQ Q
;
;
ASK(IVMTOUT) ; Ask user if ok to send financial query for patient.
;
; Input: none
;
; Output:
; Function Value: 1=Yes and 0=No
; IVMTOUT (pass by reference) 1=Timeout or up-arrow
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR("A")="Would you like to send a financial query for this patient"
S DIR("B")="YES"
S DIR(0)="Y"
W ! D ^DIR
I $D(DTOUT)!($D(DUOUT)) S IVMTOUT=1
Q +$G(Y)
;
;
NOTIFY(IVMOUT) ; Ask if user should be notified when a reply to query is received.
;
; Input: none
;
; Output:
; Function Value: 1=Yes and 0=No
; IVMOUT (pass by reference) 1=Timeout or up-arrow
;
N DIR,DTOUT,DUOUT,X,Y
S DIR("A")="Do you want to be notified when a query reply is received"
S DIR("B")="YES"
S DIR(0)="Y"
W ! D ^DIR
I $D(DTOUT)!($D(DUOUT)) S IVMOUT=1
Q +$G(Y)
;
;
NEED(DFN,IVMSENT,ERROR) ; Description: Used to determine if a financial query should be sent for a patient.
;
; Input:
; DFN - ien of patient record in PATIENT file
; IVMSENT - (optional) Check if query sent on same day 0=>No|1=>Yes
; Output:
; Function Value: Does pt. need a query? 1 on success, 0 on failure
; ERROR - If failure, return the reason for not sending
; the query (pass by reference)
;
N DGMSGF,DGADDF,DGREQF,IVMBT,IVML,SUCCESS
N IVMDOD
;
S SUCCESS=0,(DGMSGF,DGADDF)=1
I '$D(IVMSENT) S IVMSENT=1
; Can this patient be identified?
I '$G(DFN) S ERROR="PATIENT CAN NOT BE IDENTIFIED" G NEEDQ
; is this patient deceased?
S IVMDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
I IVMDOD]"" S ERROR="Patient Expired on "_$$GET1^DIQ(2,DFN_",",.351,"E")_". Financial query unnecessary." G NEEDQ
; Check to see if this patient is currently on a DOM ward.
D DOM^DGMTR I $G(DGDOM) D G NEEDQ
.S ERROR="PATIENT CURRENTLY A DOMICILIARY PATIENT - "
.S ERROR=ERROR_"QUERY NOT REQUIRED"
.K DGDOM
.Q
; Check for PRIMARY test either MEANS or Copay exemption.
S IVML=$$LST^DGMTCOU1(DFN,DT_.2359,3)
; If no primary test on file check to see if patient requires a means
; test or copay exemption test. Call to DGMTR invokes EN^DGMTCOR as
; well.
I IVML']"" D EN^DGMTR I +$G(DGREQF) S SUCCESS=1 G NEEDQ
;
; If current test is not incomplete and not required and is less than
; 365 days old, presume a current test exists, no query necessary.
; IVM*2.0*154 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
I ($P(IVML,U,4)'="I")&($P(IVML,U,4)'="R"),'$$OLDMTPF^DGMTU4($P(IVML,U,2)) D G NEEDQ
.S ERROR="PATIENT HAS A CURRENT "_$S($P(IVML,U,5)=1:"MEANS",$P(IVML,U,5)=2:"COPAY EXEMPTION",1:"MEANS")_" TEST ON FILE"
.Q
;
; If the current test is NO LONGER REQUIRED or NO LONGER APPLICABLE no
; query is necessary.
I ($P(IVML,U,4)="N")!($P(IVML,U,4)="L") D G NEEDQ
.S ERROR="PATIENT'S "_$S($P(IVML,U,5)=1:"MEANS",$P(IVML,U,5)=2:"COPAY EXEMPTION",1:"MEANS")_" TEST STATUS "_$P(IVML,U,3)_"."
.Q
;
; If current test is not REQUIRED and not NO LONGER REQUIRED and it is
; older than 365 days, initiate query.
; IVM*2.0*154 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
I ($P(IVML,U,4)'="R")&($P(IVML,U,4)'="N"),$$OLDMTPF^DGMTU4($P(IVML,U,2)) S SUCCESS=1 G NEEDQ
;
; If a query is pending, don't send another.
I $$OPEN^IVMCQ2(DFN) S ERROR="A QUERY IS ALREADY PENDING FOR THIS PATIENT" G NEEDQ
;
; if a query has already been sent today, don't send another.
I IVMSENT,$$SENT^IVMCQ2(DFN) S ERROR="A QUERY HAS BEEN SENT FOR PATIENT TODAY" G NEEDQ
;
; Has a bene travel cert been filed with a year?
S IVMBT=$O(^DGBT(392.2,"C",DFN,0))
I IVMBT,$$FMDIFF^XLFDT(DT,+$G(^DGBT(392.2,IVMBT,0))\1)>330 S SUCCESS=1 G NEEDQ
;
S ERROR="A FINANCIAL QUERY IS NOT REQUIRED FOR THIS PATIENT"
;
NEEDQ Q SUCCESS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCQ 6361 printed Sep 23, 2025@19:36:55 Page 2
IVMCQ ;ALB/KCL/AEG/GAH,BDB - API FOR FINANCIAL QUERIES ; 28-N0V-06
+1 ;;2.0;INCOME VERIFICATION MATCH;**17,30,55,120,154**;21-OCT-94;Build 28
+2 ;
+3 ;
OPT ; Entry point for stand-alone financial query option.
+1 ;
+2 NEW IVMQUIT
+3 WRITE !!,"This option allows queries to be sent to the Health Eligibility"
+4 WRITE !,"Center (HEC) for patients that require updated income information."
+5 SET IVMQUIT=0
FOR
DO EACH1
if IVMQUIT
QUIT
+6 QUIT
+7 ;
EACH1 ; Description: Used to send a financial query for each patient selected. from stand-alone option.
+1 ;
+2 NEW DFN,IVMERROR,IVMOK,IVMOUT,IVMQUE,IVMREPLY,Y
+3 SET DIC="^DPT("
SET DIC(0)="AEMQ"
+4 WRITE !
DO ^DIC
KILL DIC
SET DFN=+Y
IF Y<1
SET IVMQUIT=1
GOTO EACH1Q
+5 ;
+6 ; does patient need a financial query?
+7 IF '$$NEED(DFN,1,.IVMERROR)
WRITE !!,"A financial query can not be sent for this patient!"
WRITE !,IVMERROR
GOTO EACH1Q
+8 ;
+9 ; ask if okay to send query?
+10 IF '$$ASK(.IVMOK)!($GET(IVMOK))
GOTO EACH1Q
+11 ;
+12 ; notify when a reply to query is received?
+13 SET IVMREPLY=$$NOTIFY(.IVMOUT)
+14 IF $GET(IVMOUT)
GOTO EACH1Q
+15 ;
+16 ; send query for patient, else write error
+17 IF $$QUERY^IVMCQ1(DFN,$GET(DUZ),$GET(IVMREPLY),$GET(XQY),.IVMERROR,1)
WRITE !!,"Financial query sent ..."
+18 IF '$TEST
Begin DoDot:1
+19 WRITE !!,"Failure to send query: ",IVMERROR
End DoDot:1
+20 ;
EACH1Q QUIT
+1 ;
+2 ;
REG(DFN) ; Entry point to automatically send a query to HEC for updated financial information.
+1 ;
+2 ; This entry point is called from hooks in registration:
+3 ; - Register a Patient option (DGREG)
+4 ; - Load/Edit Patient Data option (DG10)
+5 ;
+6 ; Input:
+7 ; DFN - IEN of patient record in PATIENT file
+8 ;
+9 ; Output: none
+10 ;
+11 IF '$GET(DFN)
GOTO REGQ
+12 IF '$$NEED(DFN)
GOTO REGQ
+13 IF $$QUERY^IVMCQ1(DFN,$GET(DUZ),0,$GET(XQY),,1)
WRITE !!,"Financial query sent ..."
REGQ QUIT
+1 ;
+2 ;
APPT ; Entry point for IVM SEND FINANCIAL QUERY protocol.
+1 ;
+2 ; Input:
+3 ; SDAMEVT - IEN of record in APPOINTMENT TRANSACTION TYPE file.
+4 ; (Transaction type that can occur against an appointment)
+5 ; SDATA - Array passed from the [SDAM APPOINTMENT EVENTS]
+6 ; extended protocol. 2nd piece of SDATA is IEN of patient
+7 ; record in PATIENT file.
+8 ;
+9 ; Output: none
+10 ;
+11 NEW DFN
+12 ;
+13 ; quit if supported Sched vars not defined
+14 IF '$DATA(SDAMEVT)
GOTO APPTQ
+15 SET DFN=$PIECE($GET(SDATA),"^",2)
+16 IF 'DFN
GOTO APPTQ
+17 ;
+18 ; quit if transaction type not (make appt, check-in, check-out)
+19 IF SDAMEVT'=1
IF (SDAMEVT'=4)
IF (SDAMEVT'=5)
GOTO APPTQ
+20 ;
+21 ; does patient need query sent?
+22 IF '$$NEED(DFN,1)
GOTO APPTQ
+23 ;
+24 ; send query for patient
+25 IF $$QUERY^IVMCQ1(DFN,$GET(DUZ),0,$GET(XQY),,1)
+26 ;
APPTQ QUIT
+1 ;
+2 ;
ASK(IVMTOUT) ; Ask user if ok to send financial query for patient.
+1 ;
+2 ; Input: none
+3 ;
+4 ; Output:
+5 ; Function Value: 1=Yes and 0=No
+6 ; IVMTOUT (pass by reference) 1=Timeout or up-arrow
+7 ;
+8 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+9 WRITE !
+10 SET DIR("A")="Would you like to send a financial query for this patient"
+11 SET DIR("B")="YES"
+12 SET DIR(0)="Y"
+13 WRITE !
DO ^DIR
+14 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IVMTOUT=1
+15 QUIT +$GET(Y)
+16 ;
+17 ;
NOTIFY(IVMOUT) ; Ask if user should be notified when a reply to query is received.
+1 ;
+2 ; Input: none
+3 ;
+4 ; Output:
+5 ; Function Value: 1=Yes and 0=No
+6 ; IVMOUT (pass by reference) 1=Timeout or up-arrow
+7 ;
+8 NEW DIR,DTOUT,DUOUT,X,Y
+9 SET DIR("A")="Do you want to be notified when a query reply is received"
+10 SET DIR("B")="YES"
+11 SET DIR(0)="Y"
+12 WRITE !
DO ^DIR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IVMOUT=1
+14 QUIT +$GET(Y)
+15 ;
+16 ;
NEED(DFN,IVMSENT,ERROR) ; Description: Used to determine if a financial query should be sent for a patient.
+1 ;
+2 ; Input:
+3 ; DFN - ien of patient record in PATIENT file
+4 ; IVMSENT - (optional) Check if query sent on same day 0=>No|1=>Yes
+5 ; Output:
+6 ; Function Value: Does pt. need a query? 1 on success, 0 on failure
+7 ; ERROR - If failure, return the reason for not sending
+8 ; the query (pass by reference)
+9 ;
+10 NEW DGMSGF,DGADDF,DGREQF,IVMBT,IVML,SUCCESS
+11 NEW IVMDOD
+12 ;
+13 SET SUCCESS=0
SET (DGMSGF,DGADDF)=1
+14 IF '$DATA(IVMSENT)
SET IVMSENT=1
+15 ; Can this patient be identified?
+16 IF '$GET(DFN)
SET ERROR="PATIENT CAN NOT BE IDENTIFIED"
GOTO NEEDQ
+17 ; is this patient deceased?
+18 SET IVMDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
+19 IF IVMDOD]""
SET ERROR="Patient Expired on "_$$GET1^DIQ(2,DFN_",",.351,"E")_". Financial query unnecessary."
GOTO NEEDQ
+20 ; Check to see if this patient is currently on a DOM ward.
+21 DO DOM^DGMTR
IF $GET(DGDOM)
Begin DoDot:1
+22 SET ERROR="PATIENT CURRENTLY A DOMICILIARY PATIENT - "
+23 SET ERROR=ERROR_"QUERY NOT REQUIRED"
+24 KILL DGDOM
+25 QUIT
End DoDot:1
GOTO NEEDQ
+26 ; Check for PRIMARY test either MEANS or Copay exemption.
+27 SET IVML=$$LST^DGMTCOU1(DFN,DT_.2359,3)
+28 ; If no primary test on file check to see if patient requires a means
+29 ; test or copay exemption test. Call to DGMTR invokes EN^DGMTCOR as
+30 ; well.
+31 IF IVML']""
DO EN^DGMTR
IF +$GET(DGREQF)
SET SUCCESS=1
GOTO NEEDQ
+32 ;
+33 ; If current test is not incomplete and not required and is less than
+34 ; 365 days old, presume a current test exists, no query necessary.
+35 ; IVM*2.0*154 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+36 IF ($PIECE(IVML,U,4)'="I")&($PIECE(IVML,U,4)'="R")
IF '$$OLDMTPF^DGMTU4($PIECE(IVML,U,2))
Begin DoDot:1
+37 SET ERROR="PATIENT HAS A CURRENT "_$SELECT($PIECE(IVML,U,5)=1:"MEANS",$PIECE(IVML,U,5)=2:"COPAY EXEMPTION",1:"MEANS")_" TEST ON FILE"
+38 QUIT
End DoDot:1
GOTO NEEDQ
+39 ;
+40 ; If the current test is NO LONGER REQUIRED or NO LONGER APPLICABLE no
+41 ; query is necessary.
+42 IF ($PIECE(IVML,U,4)="N")!($PIECE(IVML,U,4)="L")
Begin DoDot:1
+43 SET ERROR="PATIENT'S "_$SELECT($PIECE(IVML,U,5)=1:"MEANS",$PIECE(IVML,U,5)=2:"COPAY EXEMPTION",1:"MEANS")_" TEST STATUS "_$PIECE(IVML,U,3)_"."
+44 QUIT
End DoDot:1
GOTO NEEDQ
+45 ;
+46 ; If current test is not REQUIRED and not NO LONGER REQUIRED and it is
+47 ; older than 365 days, initiate query.
+48 ; IVM*2.0*154 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+49 IF ($PIECE(IVML,U,4)'="R")&($PIECE(IVML,U,4)'="N")
IF $$OLDMTPF^DGMTU4($PIECE(IVML,U,2))
SET SUCCESS=1
GOTO NEEDQ
+50 ;
+51 ; If a query is pending, don't send another.
+52 IF $$OPEN^IVMCQ2(DFN)
SET ERROR="A QUERY IS ALREADY PENDING FOR THIS PATIENT"
GOTO NEEDQ
+53 ;
+54 ; if a query has already been sent today, don't send another.
+55 IF IVMSENT
IF $$SENT^IVMCQ2(DFN)
SET ERROR="A QUERY HAS BEEN SENT FOR PATIENT TODAY"
GOTO NEEDQ
+56 ;
+57 ; Has a bene travel cert been filed with a year?
+58 SET IVMBT=$ORDER(^DGBT(392.2,"C",DFN,0))
+59 IF IVMBT
IF $$FMDIFF^XLFDT(DT,+$GET(^DGBT(392.2,IVMBT,0))\1)>330
SET SUCCESS=1
GOTO NEEDQ
+60 ;
+61 SET ERROR="A FINANCIAL QUERY IS NOT REQUIRED FOR THIS PATIENT"
+62 ;
NEEDQ QUIT SUCCESS
