DGENQRY1 ;ALB/CJM - API for ENROLLMENT QUERIES (continued); 4-SEP-97 ; 5/14/02 9:57am
;;5.3;REGISTRATION;**147,232,363,472,1015**;Aug 13,1993;Build 21
;
BATCH ;
;Description: This procedure will re-send all queries still outstanding
;with status of TRANSMITTED with QUERY DT/TM of more than 2 days in the
;past.
;
;Input:
; None
;Output:
; The ENROLLMENT QUERY LOG file is updated with all the query activity. New queries to HEC are generated where necessary.
;
N QRY,DATE
S DATE=$$FMADD^XLFDT(DT,-2)
F S DATE=$O(^DGEN(27.12,"ADS",DATE),-1) Q:'DATE D
.S QRY=0
.F S QRY=$O(^DGEN(27.12,"ADS",DATE,QRY)) Q:'QRY D
..I '$$RESEND(QRY) ;then something went wrong, but continue
Q
;
RECEIVE(IEN,ERRORMSG,RMSGID) ;
;Description: This function will update the query log to show status
;RECEIVED. If the NOTIFY field is contains a user to notify, it will
;also send the notification message.
;Input:
; IEN - internal entry number of a record in the ENROLLMENT QUERY LOG
; ERRORMSG - error message to include in notification (optional)
; RMSGID - message id from the response
;
;Output:
; Function Value - 1 if successful, 0 otherwise.
;
N SUCCESS,DGQRY,DATA,IEN2,DGQRY2
S SUCCESS=0
;
D
.Q:'$G(IEN)
.Q:'$$GET^DGENQRY(IEN,.DGQRY)
.;
.;try to get a lock, but proceed anyway
.I $$LOCK^DGENQRY(DGQRY("DFN"))
.;
.;if the query was retransmitted, then update the status of the patient's last query
.I DGQRY("STATUS")=2 D
..S IEN2=$$FINDLAST^DGENQRY(DGQRY("DFN"))
..Q:'IEN2
..Q:'$$GET^DGENQRY(IEN2,.DGQRY2)
..I DGQRY2("FIRST")=DGQRY("FIRST") S IEN=IEN2 M DGQRY=DGQRY2
.;
.S DATA(.03)=$S($L($G(ERRORMSG)):4,1:3)
.S DGQRY("STATUS")=DATA(.03)
.S DATA(.06)=$$NOW^XLFDT
.S DGQRY("RESPONSE")=DATA(.06)
.S DATA(1)=$G(ERRORMSG)
.S DATA(.07)=$G(RMSGID)
.S DGQRY("RESPONSEID")=DATA(.07)
.S DGQRY("ERROR")=DATA(1)
.Q:'$$UPD^DGENDBS(27.12,IEN,.DATA)
.;
.I DGQRY("NOTIFY") I '$$NOTIFY(.DGQRY)
.;
.S SUCCESS=1
;
D:$G(DGQRY("DFN")) UNLOCK^DGENQRY(DGQRY("DFN"))
Q SUCCESS
;
NOTIFY(DGQRY) ;
;Description: send notification of reply received for enrollment query.
;
;Input:
; DGQRY() - array containing the ENROLLMENT QUERY LOG record (pass by reference)
;
;Output:
; Function Value: 1 on success, 0 on failure
;
N PATIENT,TEXT,XMDUZ,XMTEXT,XMSUB,XMSTRIP,XMROU,XMY,XMZ,XMDF
Q:'$$GET^DGENPTA($G(DGQRY("DFN")),.PATIENT) 0
;
S XMDF=""
S (XMDUN,XMDUZ)="Registration Enrollment Module"
S XMSUB="Enrollment/Eligibility Query Reply: "_PATIENT("NAME")
S XMY(DGQRY("NOTIFY"))=""
S XMTEXT="TEXT("
S TEXT(1)="A reply to the enrollment/eligibility query that you sent has been received."
S TEXT(2)=" "
S TEXT(3)="Patient Name : "_PATIENT("NAME")
S TEXT(4)="SSN : "_PATIENT("SSN")
S TEXT(5)="Query Date/Time: "_$$FMTE^XLFDT(DGQRY("FIRST"),"1")
S TEXT(6)="Query Status : "_$$EXTERNAL^DILFD(27.12,.03,"F",DGQRY("STATUS"))
;
I $L(DGQRY("ERROR")) D
.S TEXT(7)=" "
.S TEXT(8)="The following problem was encountered:"
.S TEXT(9)=" "
.S TEXT(10)=DGQRY("ERROR")
;
D ^XMD
Q 1
;
CLOSE(IEN,ERROR) ;
;Description: This function can be used to change a query with status
;of TRANSMITTED to a status of CLOSED. This will prevent retransmission.
;It can be used, for example, when an unsolicited enrollment message is
;received while a query is still outstanding.
;Input:
; IEN: The ien of a record in the ENROLLMENT QUERY LOG file.
;
;Output:
; Function Value - 1 if successful, 0 otherwise.
; ERROR - if unsuccessful, returns an error message (optional, pass by reference)
;
N SUCCESS,DGQRY,DATA
S SUCCESS=0
S ERROR=""
;
D
.I '$G(IEN) S ERROR="ENTRY IN ENROLLMENT QUERY LOG DOES NOT EXIST" Q
.Q:'$$GET^DGENQRY(IEN,.DGQRY)
.I '$$LOCK^DGENQRY(DGQRY("DFN")) S ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG" Q
.I DGQRY("STATUS") S ERROR="QUERY STATUS IS NOT TRANSMITTED" Q
.;
.S DATA(.03)=1
.I '$$UPD^DGENDBS(27.12,IEN,.DATA,.ERROR) S ERROR="UNABLE TO UPDATE ENROLLMENT QUERY LOG WITH NEW STATUS" Q
.;
.S SUCCESS=1
;
D UNLOCK^DGENQRY(DGQRY("DFN"))
Q SUCCESS
;
RESEND(IEN,ERROR) ;
;Description: Used to re-send an outstanding query.
;Input:
; IEN - ien of a record in the ENROLLMENT QUERY LOG. It identifies the query to be re-sent.
;Output:
; Function Value - 1 if successful, 0 otherwise.
; ERROR - if unsuccessful returns a mssg (pass by reference, optional)
;
N SUCCESS,DGQRY,DATA
S SUCCESS=0
S ERROR=""
;
D
.I '$G(IEN) S ERROR="ENTRY IN ENROLLMENT QUERY LOG DOES NOT EXIST" Q
.Q:'$$GET^DGENQRY(IEN,.DGQRY)
.I '$$LOCK^DGENQRY(DGQRY("DFN")) S ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG" Q
.I DGQRY("STATUS") S ERROR="QUERY STATUS IS NOT TRANSMITTED" Q
.S DATA(.03)=2
.I '$$UPD^DGENDBS(27.12,IEN,.DATA,.ERROR) S ERROR="UNABLE TO UPDATE ENROLLMENT QUERY LOG WITH NEW STATUS" Q
.I '$$SEND(DGQRY("DFN"),DGQRY("NOTIFY"),DGQRY("FIRST"),.ERROR) Q
.S SUCCESS=1
;
D UNLOCK^DGENQRY(DGQRY("DFN"))
Q SUCCESS
;
SEND(DFN,NOTIFY,FIRST,ERROR) ;
;Description: This function is used to send an ENROLLMENT/ELIGIBILITY
;QUERY to HEC for a particular patient.
;
;Input:
; DFN - the patient for whom to send the query
; NOTIFY - who should receive notification when the query reply is
; received. Is a pointer to the NEW USER file. (Optional)
; FIRST - DATE/TIME to enter to the FIRST DT/TIME field of the
; ENROLLMENT QUERY LOG file (Optional)
;
;Output:
; Function Value - 1 on success, 0 on failure.
; ERROR - if unsuccessful, this variable will return an error message, (pass by reference) (optional)
;
; quit if enrollment transmit query to HEC switch is off
I '$$ON^DGENQRY Q 0
;
N LAST,DGQRY,MSGID,SUCCESS,SENT
;
S SUCCESS=1
I '$$LOCK^DGENQRY($G(DFN)) S SUCCESS=0,ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG"
S LAST=$$FINDLAST^DGENQRY(DFN)
I SUCCESS,LAST,$$GET^DGENQRY(LAST,.DGQRY),'DGQRY("STATUS") S SUCCESS=0,ERROR="ENROLLMENT/ELIGIBILITY QUERY ALREADY SENT"
D:SUCCESS
.S SENT=$$MSG(DFN,.MSGID,.ERROR)
.I 'SENT S SUCCESS=0 Q
.S DGQRY("DFN")=DFN
.S DGQRY("SENT")=SENT
.S DGQRY("STATUS")=0
.S DGQRY("MSGID")=MSGID
.S DGQRY("NOTIFY")=$G(NOTIFY)
.S DGQRY("FIRST")=$S($G(FIRST):FIRST,1:SENT)
.S DGQRY("RESPONSE")=""
.S DGQRY("RESPONSEID")=""
.I '$$LOG^DGENQRY(.DGQRY) S SUCCESS=0,ERROR="UNABLE TO ENTER QUERY TO ENROLLMENT QUERY LOG" Q
.;
SENDQ ;
D UNLOCK^DGENQRY($G(DFN))
Q SUCCESS
;
MSG(DFN,MSGID,ERROR) ; Send enrollment/eligibility query to HEC
;
;Input:
; DFN - Pointer to the patient in file #2
;Output
; Function Value - if successful, returns 1, otherwise returns 0
; MSGID - if successful, returns the message id assigned by the HL7 package (pass by reference)
; ERROR - if unsuccessful,returns an error message (pass by reference)
;
N HLSDT,HLMTN,HLDAP,HLEVN,HLERR,HLDA,HLDAN,HLDT,HLDT1,HLECH,HLFS,HLNDAP,HLNDAP0,HLPID,HLQ,HLVER,HLMID,SUCCESS,DGPAT
N HL,HLARYTYP,HLFORMAT,HLRESLT
;
K HLA("HLS") ;DG*5.3.472
S SUCCESS=0
;
; - init HL7 variables
S HLMTN="QRY"
S HLDAP="IVM"
S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" QRY-Z11 SERVER"
S HLEID=$O(^ORD(101,"B",HLEID,0))
D INIT^HLFNC2(HLEID,.HL)
I $G(HL)]"" S HLERR=$P(HL,"^",2)
I '$D(HLERR) D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
S HLEVN=0 ; initialize event counter
S HLSDT=$$NOW^XLFDT
I $D(HLERR) S ERROR=HLERR G MSGQ
;
I '$$GET^DGENPTA(DFN,.DGPAT) S ERROR="PATIENT NOT FOUND" G MSGQ
I (DGPAT("SEX")="") S ERROR="PATIENT SEX IS REQUIRED" G MSGQ
I (DGPAT("DOB")="") S ERROR="PATIENT DATE OF BIRTH IS REQUIRED" G MSGQ
I (DGPAT("SSN")="") S ERROR="PATIENT SSN IS REQUIRED" G MSGQ
;
; - build HL7 query (QRY) msg and send
D QRD,QRF
S HLARYTYP="LM" ;DG*5.3*472
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=HLERR G MSGQ
S SUCCESS=HLSDT
;
S MSGID=+HLRESLT
;
MSGQ ; - exit and clean-up
D KILL^HLTRANS
K HLA("HLS") ;DG*5.3*472
Q SUCCESS
;
QRD ; Build (HL7) QRD segment for patient
N QUERY
S $P(QUERY,HLFS,1)=$$HLDATE^HLFNC(HLDT) ; date/time query generated
S $P(QUERY,HLFS,2)="R" ; query format code (record oriented format)
S $P(QUERY,HLFS,3)="I" ; query priority (immediate)
S $P(QUERY,HLFS,4)=DFN ; query ID (DFN)
S $P(QUERY,HLFS,7)="1~RD" ; quanity limited request (1 record)
S $P(QUERY,HLFS,8)=DGPAT("SSN") ; who subject filter (SSN)
S $P(QUERY,HLFS,9)="OTH" ; what subject filter
S $P(QUERY,HLFS,10)="ENROLLMENT" ;What department data code
S $P(QUERY,HLFS,12)="T" ; query results level (full results)
S HLA("HLS",1)="QRD"_HLFS_QUERY ;DG*5.3*472
Q
;
;
QRF ; Build HL7 (QRF) segment for patient
N FILTER
S $P(FILTER,HLFS,1)="IVM" ; where subject filter (IVM Center)
S $P(FILTER,HLFS,4)=$$HLDATE^HLFNC(DGPAT("DOB")) ; what user qualifier (DOB)
S $P(FILTER,HLFS,5)=DGPAT("SEX") ; other subj. query filter (sex)
S HLA("HLS",2)="QRF"_HLFS_FILTER ;DG*5.3*472
Q
DGENQRY1 ;ALB/CJM - API for ENROLLMENT QUERIES (continued); 4-SEP-97 ; 5/14/02 9:57am
+1 ;;5.3;REGISTRATION;**147,232,363,472,1015**;Aug 13,1993;Build 21
+2 ;
BATCH ;
+1 ;Description: This procedure will re-send all queries still outstanding
+2 ;with status of TRANSMITTED with QUERY DT/TM of more than 2 days in the
+3 ;past.
+4 ;
+5 ;Input:
+6 ; None
+7 ;Output:
+8 ; The ENROLLMENT QUERY LOG file is updated with all the query activity. New queries to HEC are generated where necessary.
+9 ;
+10 NEW QRY,DATE
+11 SET DATE=$$FMADD^XLFDT(DT,-2)
+12 FOR
SET DATE=$ORDER(^DGEN(27.12,"ADS",DATE),-1)
IF 'DATE
QUIT
Begin DoDot:1
+13 SET QRY=0
+14 FOR
SET QRY=$ORDER(^DGEN(27.12,"ADS",DATE,QRY))
IF 'QRY
QUIT
Begin DoDot:2
+15 ;then something went wrong, but continue
IF '$$RESEND(QRY)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
RECEIVE(IEN,ERRORMSG,RMSGID) ;
+1 ;Description: This function will update the query log to show status
+2 ;RECEIVED. If the NOTIFY field is contains a user to notify, it will
+3 ;also send the notification message.
+4 ;Input:
+5 ; IEN - internal entry number of a record in the ENROLLMENT QUERY LOG
+6 ; ERRORMSG - error message to include in notification (optional)
+7 ; RMSGID - message id from the response
+8 ;
+9 ;Output:
+10 ; Function Value - 1 if successful, 0 otherwise.
+11 ;
+12 NEW SUCCESS,DGQRY,DATA,IEN2,DGQRY2
+13 SET SUCCESS=0
+14 ;
+15 Begin DoDot:1
+16 IF '$GET(IEN)
QUIT
+17 IF '$$GET^DGENQRY(IEN,.DGQRY)
QUIT
+18 ;
+19 ;try to get a lock, but proceed anyway
+20 IF $$LOCK^DGENQRY(DGQRY("DFN"))
+21 ;
+22 ;if the query was retransmitted, then update the status of the patient's last query
+23 IF DGQRY("STATUS")=2
Begin DoDot:2
+24 SET IEN2=$$FINDLAST^DGENQRY(DGQRY("DFN"))
+25 IF 'IEN2
QUIT
+26 IF '$$GET^DGENQRY(IEN2,.DGQRY2)
QUIT
+27 IF DGQRY2("FIRST")=DGQRY("FIRST")
SET IEN=IEN2
MERGE DGQRY=DGQRY2
End DoDot:2
+28 ;
+29 SET DATA(.03)=$SELECT($LENGTH($GET(ERRORMSG)):4,1:3)
+30 SET DGQRY("STATUS")=DATA(.03)
+31 SET DATA(.06)=$$NOW^XLFDT
+32 SET DGQRY("RESPONSE")=DATA(.06)
+33 SET DATA(1)=$GET(ERRORMSG)
+34 SET DATA(.07)=$GET(RMSGID)
+35 SET DGQRY("RESPONSEID")=DATA(.07)
+36 SET DGQRY("ERROR")=DATA(1)
+37 IF '$$UPD^DGENDBS(27.12,IEN,.DATA)
QUIT
+38 ;
+39 IF DGQRY("NOTIFY")
IF '$$NOTIFY(.DGQRY)
+40 ;
+41 SET SUCCESS=1
End DoDot:1
+42 ;
+43 IF $GET(DGQRY("DFN"))
DO UNLOCK^DGENQRY(DGQRY("DFN"))
+44 QUIT SUCCESS
+45 ;
NOTIFY(DGQRY) ;
+1 ;Description: send notification of reply received for enrollment query.
+2 ;
+3 ;Input:
+4 ; DGQRY() - array containing the ENROLLMENT QUERY LOG record (pass by reference)
+5 ;
+6 ;Output:
+7 ; Function Value: 1 on success, 0 on failure
+8 ;
+9 NEW PATIENT,TEXT,XMDUZ,XMTEXT,XMSUB,XMSTRIP,XMROU,XMY,XMZ,XMDF
+10 IF '$$GET^DGENPTA($GET(DGQRY("DFN")),.PATIENT)
QUIT 0
+11 ;
+12 SET XMDF=""
+13 SET (XMDUN,XMDUZ)="Registration Enrollment Module"
+14 SET XMSUB="Enrollment/Eligibility Query Reply: "_PATIENT("NAME")
+15 SET XMY(DGQRY("NOTIFY"))=""
+16 SET XMTEXT="TEXT("
+17 SET TEXT(1)="A reply to the enrollment/eligibility query that you sent has been received."
+18 SET TEXT(2)=" "
+19 SET TEXT(3)="Patient Name : "_PATIENT("NAME")
+20 SET TEXT(4)="SSN : "_PATIENT("SSN")
+21 SET TEXT(5)="Query Date/Time: "_$$FMTE^XLFDT(DGQRY("FIRST"),"1")
+22 SET TEXT(6)="Query Status : "_$$EXTERNAL^DILFD(27.12,.03,"F",DGQRY("STATUS"))
+23 ;
+24 IF $LENGTH(DGQRY("ERROR"))
Begin DoDot:1
+25 SET TEXT(7)=" "
+26 SET TEXT(8)="The following problem was encountered:"
+27 SET TEXT(9)=" "
+28 SET TEXT(10)=DGQRY("ERROR")
End DoDot:1
+29 ;
+30 DO ^XMD
+31 QUIT 1
+32 ;
CLOSE(IEN,ERROR) ;
+1 ;Description: This function can be used to change a query with status
+2 ;of TRANSMITTED to a status of CLOSED. This will prevent retransmission.
+3 ;It can be used, for example, when an unsolicited enrollment message is
+4 ;received while a query is still outstanding.
+5 ;Input:
+6 ; IEN: The ien of a record in the ENROLLMENT QUERY LOG file.
+7 ;
+8 ;Output:
+9 ; Function Value - 1 if successful, 0 otherwise.
+10 ; ERROR - if unsuccessful, returns an error message (optional, pass by reference)
+11 ;
+12 NEW SUCCESS,DGQRY,DATA
+13 SET SUCCESS=0
+14 SET ERROR=""
+15 ;
+16 Begin DoDot:1
+17 IF '$GET(IEN)
SET ERROR="ENTRY IN ENROLLMENT QUERY LOG DOES NOT EXIST"
QUIT
+18 IF '$$GET^DGENQRY(IEN,.DGQRY)
QUIT
+19 IF '$$LOCK^DGENQRY(DGQRY("DFN"))
SET ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG"
QUIT
+20 IF DGQRY("STATUS")
SET ERROR="QUERY STATUS IS NOT TRANSMITTED"
QUIT
+21 ;
+22 SET DATA(.03)=1
+23 IF '$$UPD^DGENDBS(27.12,IEN,.DATA,.ERROR)
SET ERROR="UNABLE TO UPDATE ENROLLMENT QUERY LOG WITH NEW STATUS"
QUIT
+24 ;
+25 SET SUCCESS=1
End DoDot:1
+26 ;
+27 DO UNLOCK^DGENQRY(DGQRY("DFN"))
+28 QUIT SUCCESS
+29 ;
RESEND(IEN,ERROR) ;
+1 ;Description: Used to re-send an outstanding query.
+2 ;Input:
+3 ; IEN - ien of a record in the ENROLLMENT QUERY LOG. It identifies the query to be re-sent.
+4 ;Output:
+5 ; Function Value - 1 if successful, 0 otherwise.
+6 ; ERROR - if unsuccessful returns a mssg (pass by reference, optional)
+7 ;
+8 NEW SUCCESS,DGQRY,DATA
+9 SET SUCCESS=0
+10 SET ERROR=""
+11 ;
+12 Begin DoDot:1
+13 IF '$GET(IEN)
SET ERROR="ENTRY IN ENROLLMENT QUERY LOG DOES NOT EXIST"
QUIT
+14 IF '$$GET^DGENQRY(IEN,.DGQRY)
QUIT
+15 IF '$$LOCK^DGENQRY(DGQRY("DFN"))
SET ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG"
QUIT
+16 IF DGQRY("STATUS")
SET ERROR="QUERY STATUS IS NOT TRANSMITTED"
QUIT
+17 SET DATA(.03)=2
+18 IF '$$UPD^DGENDBS(27.12,IEN,.DATA,.ERROR)
SET ERROR="UNABLE TO UPDATE ENROLLMENT QUERY LOG WITH NEW STATUS"
QUIT
+19 IF '$$SEND(DGQRY("DFN"),DGQRY("NOTIFY"),DGQRY("FIRST"),.ERROR)
QUIT
+20 SET SUCCESS=1
End DoDot:1
+21 ;
+22 DO UNLOCK^DGENQRY(DGQRY("DFN"))
+23 QUIT SUCCESS
+24 ;
SEND(DFN,NOTIFY,FIRST,ERROR) ;
+1 ;Description: This function is used to send an ENROLLMENT/ELIGIBILITY
+2 ;QUERY to HEC for a particular patient.
+3 ;
+4 ;Input:
+5 ; DFN - the patient for whom to send the query
+6 ; NOTIFY - who should receive notification when the query reply is
+7 ; received. Is a pointer to the NEW USER file. (Optional)
+8 ; FIRST - DATE/TIME to enter to the FIRST DT/TIME field of the
+9 ; ENROLLMENT QUERY LOG file (Optional)
+10 ;
+11 ;Output:
+12 ; Function Value - 1 on success, 0 on failure.
+13 ; ERROR - if unsuccessful, this variable will return an error message, (pass by reference) (optional)
+14 ;
+15 ; quit if enrollment transmit query to HEC switch is off
+16 IF '$$ON^DGENQRY
QUIT 0
+17 ;
+18 NEW LAST,DGQRY,MSGID,SUCCESS,SENT
+19 ;
+20 SET SUCCESS=1
+21 IF '$$LOCK^DGENQRY($GET(DFN))
SET SUCCESS=0
SET ERROR="UNABLE TO LOCK ENROLLMENT QUERY LOG"
+22 SET LAST=$$FINDLAST^DGENQRY(DFN)
+23 IF SUCCESS
IF LAST
IF $$GET^DGENQRY(LAST,.DGQRY)
IF 'DGQRY("STATUS")
SET SUCCESS=0
SET ERROR="ENROLLMENT/ELIGIBILITY QUERY ALREADY SENT"
+24 IF SUCCESS
Begin DoDot:1
+25 SET SENT=$$MSG(DFN,.MSGID,.ERROR)
+26 IF 'SENT
SET SUCCESS=0
QUIT
+27 SET DGQRY("DFN")=DFN
+28 SET DGQRY("SENT")=SENT
+29 SET DGQRY("STATUS")=0
+30 SET DGQRY("MSGID")=MSGID
+31 SET DGQRY("NOTIFY")=$GET(NOTIFY)
+32 SET DGQRY("FIRST")=$SELECT($GET(FIRST):FIRST,1:SENT)
+33 SET DGQRY("RESPONSE")=""
+34 SET DGQRY("RESPONSEID")=""
+35 IF '$$LOG^DGENQRY(.DGQRY)
SET SUCCESS=0
SET ERROR="UNABLE TO ENTER QUERY TO ENROLLMENT QUERY LOG"
QUIT
+36 ;
End DoDot:1
SENDQ ;
+1 DO UNLOCK^DGENQRY($GET(DFN))
+2 QUIT SUCCESS
+3 ;
MSG(DFN,MSGID,ERROR) ; Send enrollment/eligibility query to HEC
+1 ;
+2 ;Input:
+3 ; DFN - Pointer to the patient in file #2
+4 ;Output
+5 ; Function Value - if successful, returns 1, otherwise returns 0
+6 ; MSGID - if successful, returns the message id assigned by the HL7 package (pass by reference)
+7 ; ERROR - if unsuccessful,returns an error message (pass by reference)
+8 ;
+9 NEW HLSDT,HLMTN,HLDAP,HLEVN,HLERR,HLDA,HLDAN,HLDT,HLDT1,HLECH,HLFS,HLNDAP,HLNDAP0,HLPID,HLQ,HLVER,HLMID,SUCCESS,DGPAT
+10 NEW HL,HLARYTYP,HLFORMAT,HLRESLT
+11 ;
+12 ;DG*5.3.472
KILL HLA("HLS")
+13 SET SUCCESS=0
+14 ;
+15 ; - init HL7 variables
+16 SET HLMTN="QRY"
+17 SET HLDAP="IVM"
+18 SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" QRY-Z11 SERVER"
+19 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
+20 DO INIT^HLFNC2(HLEID,.HL)
+21 IF $GET(HL)]""
SET HLERR=$PIECE(HL,"^",2)
+22 IF '$DATA(HLERR)
DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
+23 ; initialize event counter
SET HLEVN=0
+24 SET HLSDT=$$NOW^XLFDT
+25 IF $DATA(HLERR)
SET ERROR=HLERR
GOTO MSGQ
+26 ;
+27 IF '$$GET^DGENPTA(DFN,.DGPAT)
SET ERROR="PATIENT NOT FOUND"
GOTO MSGQ
+28 IF (DGPAT("SEX")="")
SET ERROR="PATIENT SEX IS REQUIRED"
GOTO MSGQ
+29 IF (DGPAT("DOB")="")
SET ERROR="PATIENT DATE OF BIRTH IS REQUIRED"
GOTO MSGQ
+30 IF (DGPAT("SSN")="")
SET ERROR="PATIENT SSN IS REQUIRED"
GOTO MSGQ
+31 ;
+32 ; - build HL7 query (QRY) msg and send
+33 DO QRD
DO QRF
+34 ;DG*5.3*472
SET HLARYTYP="LM"
+35 SET HLFORMAT=1
+36 DO GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT)
+37 IF $PIECE($GET(HLRESLT),"^",2)]""
SET HLERR=$PIECE(HLRESLT,"^",3)
+38 IF $DATA(HLERR)
SET ERROR=HLERR
GOTO MSGQ
+39 SET SUCCESS=HLSDT
+40 ;
+41 SET MSGID=+HLRESLT
+42 ;
MSGQ ; - exit and clean-up
+1 DO KILL^HLTRANS
+2 ;DG*5.3*472
KILL HLA("HLS")
+3 QUIT SUCCESS
+4 ;
QRD ; Build (HL7) QRD segment for patient
+1 NEW QUERY
+2 ; date/time query generated
SET $PIECE(QUERY,HLFS,1)=$$HLDATE^HLFNC(HLDT)
+3 ; query format code (record oriented format)
SET $PIECE(QUERY,HLFS,2)="R"
+4 ; query priority (immediate)
SET $PIECE(QUERY,HLFS,3)="I"
+5 ; query ID (DFN)
SET $PIECE(QUERY,HLFS,4)=DFN
+6 ; quanity limited request (1 record)
SET $PIECE(QUERY,HLFS,7)="1~RD"
+7 ; who subject filter (SSN)
SET $PIECE(QUERY,HLFS,8)=DGPAT("SSN")
+8 ; what subject filter
SET $PIECE(QUERY,HLFS,9)="OTH"
+9 ;What department data code
SET $PIECE(QUERY,HLFS,10)="ENROLLMENT"
+10 ; query results level (full results)
SET $PIECE(QUERY,HLFS,12)="T"
+11 ;DG*5.3*472
SET HLA("HLS",1)="QRD"_HLFS_QUERY
+12 QUIT
+13 ;
+14 ;
QRF ; Build HL7 (QRF) segment for patient
+1 NEW FILTER
+2 ; where subject filter (IVM Center)
SET $PIECE(FILTER,HLFS,1)="IVM"
+3 ; what user qualifier (DOB)
SET $PIECE(FILTER,HLFS,4)=$$HLDATE^HLFNC(DGPAT("DOB"))
+4 ; other subj. query filter (sex)
SET $PIECE(FILTER,HLFS,5)=DGPAT("SEX")
+5 ;DG*5.3*472
SET HLA("HLS",2)="QRF"_HLFS_FILTER
+6 QUIT
