IVMCQ1 ;ALB/KCL - API FOR FINANCIAL QUERIES (continued) ; 7/6/01 1:10pm
 ;;2.0;INCOME VERIFICATION MATCH;**17,23,34,63**;21-OCT-94
 ;
QUERY(DFN,USER,NOTIFY,OPTION,ERROR,RECENT) ; Build/send HL7 financial query for a patient.
 ;
 ;  Input:
 ;      DFN - ien of patient record in PATIENT file (required)
 ;     USER - user initiating the query.  Pointer to NEW USER
 ;            file. (optional)
 ;   NOTIFY - flag to determine if user should be notified when a
 ;            query reply is received. (optional)
 ;   OPTION - option query is initiated from. Ien of record in
 ;            OPTION file. (optional) 
 ;   RECENT - a flag, if set to 1, a check will be done to determine
 ;            if a query is currently open OR recently sent(optional)
 ;
 ; Output:
 ;  Function Value: 1 on success, 0 on failure
 ;   ERROR - if failure, returns error msg (pass by reference)
 ;
 N DATA,DG,DGENDA
 N HLDA,HLDAN,HLDAP,HLDT,HLDT1,HLECH,HLERR,HLEVN,HLFS,HLMID,HLMTN,HLNDAP,HLNDAP0,HLPID,HLQ,HLSDT,HLVER
 N IVMCID,IVMIEN,IVMPAT,IVMQRY,SUCCESS,XMTEXT
 N HL,HLEID
 ;
 S SUCCESS=0
 ;
 ; check if DCD messaging is active
 I '$$DCDON^IVMUPAR1() S ERROR="MESSAGING IS DISABLED." G Q2
 I $G(IVMZ10)="UPLOAD IN PROGRESS" S ERROR="FINANCIAL UPLOAD IS IN PROGRESS" G Q2
 ;
 ; for synchronization and to avoid multiple queries on the same day
 ; for the same patient, LOCK the IVM FINANCIAL QUERY LOG file before
 ; doing two query checks...
 L +^IVM(301.62,"ADT1",DFN):15
 I '$T S ERROR="UNABLE TO SEND A QUERY AT THIS TIME" G Q2
 ;
 ; if RECENT flag, quit if query is currently open OR just sent
 I $G(RECENT)=1,$$RECENT(DFN) S ERROR="A FINANCIAL QUERY IS CURRENTLY OPEN OR JUST SENT" G Q2
 ;
 ; regardless of RECENT flag, check to see if a query has already been
 ; sent out for this patient today...
 I $$SENT^IVMCQ2(DFN) S ERROR="A FINANCIAL QUERY HAS ALREADY BEEN SENT FOR THIS PATIENT TODAY" G Q2
 ;
 ; no query RECENT or SENT today.  set a stub record in 301.62 and
 ; release the lock.  the stub will contain the patient DFN and
 ; today's date so that the "ADT1" x-ref is set and subsequent checks
 ; both in DG and IVM processes will find a query sent today...
 S DATA(.01)=DFN
 S DATA(.02)=$$NOW^XLFDT
 S IVMIEN=$$ADD^DGENDBS(301.62,,.DATA)
 L -^IVM(301.62,"ADT1",DFN)
 K DATA
 K ^TMP("HLS",$J)                                        ;IVM*2*63
 ;
 ; init HL7 variables
 S HLMTN="QRY"
 S HLDAP="IVM"
 S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" QRY-Z10 SERVER"
 S HLEID=$O(^ORD(101,"B",HLEID,0))
 D INIT^HLFNC2(HLEID,.HL)
 I $G(HL)]"" S HLERR=$P(HL,"^",2)
 S HLEVN=0 ; init msg event counter
 S HLSDT=$$NOW^XLFDT
 I $D(HLERR) S ERROR="HL7 INITIALIZATION ERROR - "_HLERR G QUERYQ
 ;
 ; get patient identifiers
 I '$$GETPAT^IVMUFNC(DFN,.IVMPAT) S ERROR="PATIENT NOT FOUND" G QUERYQ
 I (IVMPAT("DOB")="") S ERROR="PATIENT DATE OF BIRTH IS REQUIRED" G QUERYQ
 I (IVMPAT("SSN")="") S ERROR="PATIENT SSN IS REQUIRED" G QUERYQ
 I (IVMPAT("SEX")="") S ERROR="PATIENT SEX IS REQUIRED" G QUERYQ
 I "MF"'[IVMPAT("SEX") S ERROR="PATIENT SEX IS NOT VALID" G QUERYQ
 ;
 ; build HL7 financial query (QRY) message components...
 D QRD
 D QRF
 ;
 ; send the message...
 S HLARYTYP="GM"
 S HLFORMAT=1
 D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT)
 I $P($G(HLRESLT),"^",2)]"" S HLERR=$P(HLRESLT,"^",3)
 I $D(HLERR) S ERROR="HL7 TRANSMISSION ERROR - "_HLERR G QUERYQ
 ;
 ;S IVMCID=$G(MID)
 S IVMCID=+HLRESLT
 ;
 ; update our record in the LOG file...
 S DATA(.03)=0
 S DATA(.04)=$G(USER)
 S DATA(.05)=IVMCID
 S DATA(.06)=""
 S DATA(.07)=$G(OPTION)
 S DATA(.08)=$S($G(NOTIFY):1,1:0)
 S DGENDA=IVMIEN
 I '$$UPD^DGENDBS(301.62,.DGENDA,.DATA) S ERROR="UPDATE OF RECORD "_IVMIEN_" IN 301.62 FAILED!" G QUERYQ
 ;
 S SUCCESS=1
 ;
QUERYQ ; exit and clean-up
 D KILL^HLTRANS
 K ^TMP("HLS",$J)       ;IVM*2*63 - K ^TMP("HLS",$J,HLSDT)
Q2 ;
 L -^IVM(301.62,"ADT1",DFN)
 Q SUCCESS
 ;
QUERY2(DFN,USER,NOTIFY,OPTION,ERROR,RECENT) ; Build/send HL7 financial query for a patient.
 ;
 ; Same input/output parameters as described in module QUERY above.
 ;
 I $$QUERY($G(DFN),$G(USER),$G(NOTIFY),$G(OPTION),.ERROR,$G(RECENT))
 Q
 ;
QRD ; Build (HL7) QRD segment for patient
 ;
 N IVMQRD
 ; date/time query generated...
 S $P(IVMQRD,HLFS,1)=$$HLDATE^HLFNC(HLSDT)
 ; query format code (record-oriented format)...
 S $P(IVMQRD,HLFS,2)="R"
 ; query priority (immediate)...
 S $P(IVMQRD,HLFS,3)="I"
 ; query ID (patient's DFN)...
 S $P(IVMQRD,HLFS,4)=DFN
 ; quantity-limited request (1 record)...
 S $P(IVMQRD,HLFS,7)="1~RD"
 ; "who" subject filter (=SSN)...
 S $P(IVMQRD,HLFS,8)=IVMPAT("SSN")
 ; "what" subject filter (=financial)...
 S $P(IVMQRD,HLFS,9)="FIN"
 ; what department data code (=income year)...
 S $P(IVMQRD,HLFS,10)=$$HLDATE^HLFNC($$LYR^DGMTSCU1(DT))
 ; query results level (full results)...
 S $P(IVMQRD,HLFS,12)="T"
 S ^TMP("HLS",$J,1)="QRD"_HLFS_IVMQRD
 Q
 ;
 ;
QRF ; Build HL7 (QRF) segment for patient
 ;
 N IVMQRF
 ; "where" subject filter (=IVM)...
 S $P(IVMQRF,HLFS,1)="IVM"
 ; what user qualifier (DOB)...
 S $P(IVMQRF,HLFS,4)=$$HLDATE^HLFNC(IVMPAT("DOB"))
 ; other subject query filter (SEX)...
 S $P(IVMQRF,HLFS,5)=IVMPAT("SEX")
 S ^TMP("HLS",$J,2)="QRF"_HLFS_IVMQRF
 Q
 ;
RECENT(DFN) ; Determine if a patient has a financial query that is open OR recently responded to (last 2 minutes)
 ;
 ;  Input: DFN - ien of patient record in PATIENT file
 ; Output: returns 1 if open query, otherwise returns 0.
 ;
 N IVMQRY,IVMIEN,RECENT
 S RECENT=0
 S IVMIEN=$$LASTQRY^IVMCQ2($G(DFN))
 I IVMIEN,$$GET^IVMCQ2(IVMIEN,.IVMQRY) D
 .I 'IVMQRY("STATUS") S RECENT=1 Q
 .I (($$NOW^XLFDT-IVMQRY("RESPONSE"))<.0003) S RECENT=1
 Q RECENT
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCQ1   5762     printed  Sep 23, 2025@19:36:56                                                                                                                                                                                                      Page 2
IVMCQ1    ;ALB/KCL - API FOR FINANCIAL QUERIES (continued) ; 7/6/01 1:10pm
 +1       ;;2.0;INCOME VERIFICATION MATCH;**17,23,34,63**;21-OCT-94
 +2       ;
QUERY(DFN,USER,NOTIFY,OPTION,ERROR,RECENT) ; Build/send HL7 financial query for a patient.
 +1       ;
 +2       ;  Input:
 +3       ;      DFN - ien of patient record in PATIENT file (required)
 +4       ;     USER - user initiating the query.  Pointer to NEW USER
 +5       ;            file. (optional)
 +6       ;   NOTIFY - flag to determine if user should be notified when a
 +7       ;            query reply is received. (optional)
 +8       ;   OPTION - option query is initiated from. Ien of record in
 +9       ;            OPTION file. (optional) 
 +10      ;   RECENT - a flag, if set to 1, a check will be done to determine
 +11      ;            if a query is currently open OR recently sent(optional)
 +12      ;
 +13      ; Output:
 +14      ;  Function Value: 1 on success, 0 on failure
 +15      ;   ERROR - if failure, returns error msg (pass by reference)
 +16      ;
 +17       NEW DATA,DG,DGENDA
 +18       NEW HLDA,HLDAN,HLDAP,HLDT,HLDT1,HLECH,HLERR,HLEVN,HLFS,HLMID,HLMTN,HLNDAP,HLNDAP0,HLPID,HLQ,HLSDT,HLVER
 +19       NEW IVMCID,IVMIEN,IVMPAT,IVMQRY,SUCCESS,XMTEXT
 +20       NEW HL,HLEID
 +21      ;
 +22       SET SUCCESS=0
 +23      ;
 +24      ; check if DCD messaging is active
 +25       IF '$$DCDON^IVMUPAR1()
               SET ERROR="MESSAGING IS DISABLED."
               GOTO Q2
 +26       IF $GET(IVMZ10)="UPLOAD IN PROGRESS"
               SET ERROR="FINANCIAL UPLOAD IS IN PROGRESS"
               GOTO Q2
 +27      ;
 +28      ; for synchronization and to avoid multiple queries on the same day
 +29      ; for the same patient, LOCK the IVM FINANCIAL QUERY LOG file before
 +30      ; doing two query checks...
 +31       LOCK +^IVM(301.62,"ADT1",DFN):15
 +32       IF '$TEST
               SET ERROR="UNABLE TO SEND A QUERY AT THIS TIME"
               GOTO Q2
 +33      ;
 +34      ; if RECENT flag, quit if query is currently open OR just sent
 +35       IF $GET(RECENT)=1
               IF $$RECENT(DFN)
                   SET ERROR="A FINANCIAL QUERY IS CURRENTLY OPEN OR JUST SENT"
                   GOTO Q2
 +36      ;
 +37      ; regardless of RECENT flag, check to see if a query has already been
 +38      ; sent out for this patient today...
 +39       IF $$SENT^IVMCQ2(DFN)
               SET ERROR="A FINANCIAL QUERY HAS ALREADY BEEN SENT FOR THIS PATIENT TODAY"
               GOTO Q2
 +40      ;
 +41      ; no query RECENT or SENT today.  set a stub record in 301.62 and
 +42      ; release the lock.  the stub will contain the patient DFN and
 +43      ; today's date so that the "ADT1" x-ref is set and subsequent checks
 +44      ; both in DG and IVM processes will find a query sent today...
 +45       SET DATA(.01)=DFN
 +46       SET DATA(.02)=$$NOW^XLFDT
 +47       SET IVMIEN=$$ADD^DGENDBS(301.62,,.DATA)
 +48       LOCK -^IVM(301.62,"ADT1",DFN)
 +49       KILL DATA
 +50      ;IVM*2*63
           KILL ^TMP("HLS",$JOB)
 +51      ;
 +52      ; init HL7 variables
 +53       SET HLMTN="QRY"
 +54       SET HLDAP="IVM"
 +55       SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" QRY-Z10 SERVER"
 +56       SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
 +57       DO INIT^HLFNC2(HLEID,.HL)
 +58       IF $GET(HL)]""
               SET HLERR=$PIECE(HL,"^",2)
 +59      ; init msg event counter
           SET HLEVN=0
 +60       SET HLSDT=$$NOW^XLFDT
 +61       IF $DATA(HLERR)
               SET ERROR="HL7 INITIALIZATION ERROR - "_HLERR
               GOTO QUERYQ
 +62      ;
 +63      ; get patient identifiers
 +64       IF '$$GETPAT^IVMUFNC(DFN,.IVMPAT)
               SET ERROR="PATIENT NOT FOUND"
               GOTO QUERYQ
 +65       IF (IVMPAT("DOB")="")
               SET ERROR="PATIENT DATE OF BIRTH IS REQUIRED"
               GOTO QUERYQ
 +66       IF (IVMPAT("SSN")="")
               SET ERROR="PATIENT SSN IS REQUIRED"
               GOTO QUERYQ
 +67       IF (IVMPAT("SEX")="")
               SET ERROR="PATIENT SEX IS REQUIRED"
               GOTO QUERYQ
 +68       IF "MF"'[IVMPAT("SEX")
               SET ERROR="PATIENT SEX IS NOT VALID"
               GOTO QUERYQ
 +69      ;
 +70      ; build HL7 financial query (QRY) message components...
 +71       DO QRD
 +72       DO QRF
 +73      ;
 +74      ; send the message...
 +75       SET HLARYTYP="GM"
 +76       SET HLFORMAT=1
 +77       DO GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT)
 +78       IF $PIECE($GET(HLRESLT),"^",2)]""
               SET HLERR=$PIECE(HLRESLT,"^",3)
 +79       IF $DATA(HLERR)
               SET ERROR="HL7 TRANSMISSION ERROR - "_HLERR
               GOTO QUERYQ
 +80      ;
 +81      ;S IVMCID=$G(MID)
 +82       SET IVMCID=+HLRESLT
 +83      ;
 +84      ; update our record in the LOG file...
 +85       SET DATA(.03)=0
 +86       SET DATA(.04)=$GET(USER)
 +87       SET DATA(.05)=IVMCID
 +88       SET DATA(.06)=""
 +89       SET DATA(.07)=$GET(OPTION)
 +90       SET DATA(.08)=$SELECT($GET(NOTIFY):1,1:0)
 +91       SET DGENDA=IVMIEN
 +92       IF '$$UPD^DGENDBS(301.62,.DGENDA,.DATA)
               SET ERROR="UPDATE OF RECORD "_IVMIEN_" IN 301.62 FAILED!"
               GOTO QUERYQ
 +93      ;
 +94       SET SUCCESS=1
 +95      ;
QUERYQ    ; exit and clean-up
 +1        DO KILL^HLTRANS
 +2       ;IVM*2*63 - K ^TMP("HLS",$J,HLSDT)
           KILL ^TMP("HLS",$JOB)
Q2        ;
 +1        LOCK -^IVM(301.62,"ADT1",DFN)
 +2        QUIT SUCCESS
 +3       ;
QUERY2(DFN,USER,NOTIFY,OPTION,ERROR,RECENT) ; Build/send HL7 financial query for a patient.
 +1       ;
 +2       ; Same input/output parameters as described in module QUERY above.
 +3       ;
 +4        IF $$QUERY($GET(DFN),$GET(USER),$GET(NOTIFY),$GET(OPTION),.ERROR,$GET(RECENT))
 +5        QUIT 
 +6       ;
QRD       ; Build (HL7) QRD segment for patient
 +1       ;
 +2        NEW IVMQRD
 +3       ; date/time query generated...
 +4        SET $PIECE(IVMQRD,HLFS,1)=$$HLDATE^HLFNC(HLSDT)
 +5       ; query format code (record-oriented format)...
 +6        SET $PIECE(IVMQRD,HLFS,2)="R"
 +7       ; query priority (immediate)...
 +8        SET $PIECE(IVMQRD,HLFS,3)="I"
 +9       ; query ID (patient's DFN)...
 +10       SET $PIECE(IVMQRD,HLFS,4)=DFN
 +11      ; quantity-limited request (1 record)...
 +12       SET $PIECE(IVMQRD,HLFS,7)="1~RD"
 +13      ; "who" subject filter (=SSN)...
 +14       SET $PIECE(IVMQRD,HLFS,8)=IVMPAT("SSN")
 +15      ; "what" subject filter (=financial)...
 +16       SET $PIECE(IVMQRD,HLFS,9)="FIN"
 +17      ; what department data code (=income year)...
 +18       SET $PIECE(IVMQRD,HLFS,10)=$$HLDATE^HLFNC($$LYR^DGMTSCU1(DT))
 +19      ; query results level (full results)...
 +20       SET $PIECE(IVMQRD,HLFS,12)="T"
 +21       SET ^TMP("HLS",$JOB,1)="QRD"_HLFS_IVMQRD
 +22       QUIT 
 +23      ;
 +24      ;
QRF       ; Build HL7 (QRF) segment for patient
 +1       ;
 +2        NEW IVMQRF
 +3       ; "where" subject filter (=IVM)...
 +4        SET $PIECE(IVMQRF,HLFS,1)="IVM"
 +5       ; what user qualifier (DOB)...
 +6        SET $PIECE(IVMQRF,HLFS,4)=$$HLDATE^HLFNC(IVMPAT("DOB"))
 +7       ; other subject query filter (SEX)...
 +8        SET $PIECE(IVMQRF,HLFS,5)=IVMPAT("SEX")
 +9        SET ^TMP("HLS",$JOB,2)="QRF"_HLFS_IVMQRF
 +10       QUIT 
 +11      ;
RECENT(DFN) ; Determine if a patient has a financial query that is open OR recently responded to (last 2 minutes)
 +1       ;
 +2       ;  Input: DFN - ien of patient record in PATIENT file
 +3       ; Output: returns 1 if open query, otherwise returns 0.
 +4       ;
 +5        NEW IVMQRY,IVMIEN,RECENT
 +6        SET RECENT=0
 +7        SET IVMIEN=$$LASTQRY^IVMCQ2($GET(DFN))
 +8        IF IVMIEN
               IF $$GET^IVMCQ2(IVMIEN,.IVMQRY)
                   Begin DoDot:1
 +9                    IF 'IVMQRY("STATUS")
                           SET RECENT=1
                           QUIT 
 +10                   IF (($$NOW^XLFDT-IVMQRY("RESPONSE"))<.0003)
                           SET RECENT=1
                   End DoDot:1
 +11       QUIT RECENT