IBARXCQR ;ALB/LEG-CERNER RXCOPAY SEND QRY REQUEST ; 23 Feb 2021
;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
;
;Build and send to cerner the IBARXC-QRY - QRY^R02 query requesting cerner seeding data
;
EN(DFN,IBDT) ;start processing message
; DFN - IEN of Patient
; IBDT - date within the required billing period
;
N %P1,ERROR,FIELD,ICN,MSG,SEG,VALUE,WHOTO,X,XDT,XXX,NAME
N PARMS
;S FACID=$$SITE^VASITE
D MSH
D QRD
D QRF
D SEND
Q
;
MSH ;SET VARIABLES FOR THE MSH SEGMENT
N PARMS K ^TMP("QRY")
S PARMS("COUNTRY")="USA"
S PARMS("MESSAGE TYPE")="QRY"
S PARMS("EVENT")="R02"
S PARMS("VERSION")="2.3"
S PARMS("MESSAGE STRUCTURE")="QRY_R02"
S MSG="^TMP("_"QRY"
S X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
Q
;
QRD ;BUILD THE QRD SEGMENT
S VALUE="QRD",FIELD=0 D SET^HLOAPI(.SEG,VALUE,FIELD)
S %P1=$$NOW^XLFDT() S %P1=$$FMTHL7^XLFDT(%P1)
S VALUE=%P1,FIELD=1 D SET^HLOAPI(.SEG,VALUE,FIELD)
S VALUE=1,FIELD=2 D SET^HLOAPI(.SEG,VALUE,FIELD)
S VALUE=1,FIELD=3 D SET^HLOAPI(.SEG,VALUE,FIELD)
;Need to speak with VDIF about this not being available
;S X=FACID_" A"
;S X=$O(^HLB("B",X),-1)
;S X=$O(^HLB("B",X,0))
;S QRYNUM=X+1
;S VALUE=$G(QRYNUM),FIELD=4 D SET^HLOAPI(.SEG,VALUE,FIELD)
S VALUE=1,FIELD=7 D SET^HLOAPI(.SEG,VALUE,FIELD)
S NAME=$$GET1^DIQ(2,DFN_",",.01)
S VALUE=$P(NAME,",",1),FIELD=8 D SET^HLOAPI(.SEG,VALUE,FIELD,1)
S VALUE=$P(NAME,",",2),FIELD=8 D SET^HLOAPI(.SEG,VALUE,FIELD,2)
S ICN=$$ICN^IBARXMU(DFN)
S VALUE=ICN,FIELD=9 D SET^HLOAPI(.SEG,VALUE,FIELD)
S VALUE="",FIELD=10 D SET^HLOAPI(.SEG,VALUE,FIELD)
S FIELD=11
S VALUE=$E(IBDT,4,5) D SET^HLOAPI(.SEG,VALUE,FIELD,1)
S VALUE=($E(IBDT,1,3)+1700) D SET^HLOAPI(.SEG,VALUE,FIELD,2)
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
Q
;
QRF ;
S FIELD=0,VALUE="QRF" D SET^HLOAPI(.SEG,VALUE,FIELD)
S FIELD=1,VALUE="IBARXC-TRANS" D SET^HLOAPI(.SEG,VALUE,FIELD)
S FIELD=4,X=$$GET1^DIQ(2,DFN_",",.09),VALUE=$E(X,$L(X)-3,$L(X)) D SET^HLOAPI(.SEG,VALUE,FIELD) ;Last 4 of SSN
S X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
Q
;
SEND ;SEND THE MESSAGE
S PARMS("SENDING APPLICATION")="IBARXC-QRY"
S WHOTO("RECEIVING APPLICATION")="IBARXC-QRYRESP"
S WHOTO("STATION NUMBER")="200CRNR"
S WHOTO("MIDDLEWARE LINK NAME")="IBARXCVDF"
S XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
H 20
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXCQR 2347 printed Jun 11, 2024@21:59:52 Page 2
IBARXCQR ;ALB/LEG-CERNER RXCOPAY SEND QRY REQUEST ; 23 Feb 2021
+1 ;;2.0;INTEGRATED BILLING;**676**;21-MAR-94;Build 34
+2 ;
+3 ;Build and send to cerner the IBARXC-QRY - QRY^R02 query requesting cerner seeding data
+4 ;
EN(DFN,IBDT) ;start processing message
+1 ; DFN - IEN of Patient
+2 ; IBDT - date within the required billing period
+3 ;
+4 NEW %P1,ERROR,FIELD,ICN,MSG,SEG,VALUE,WHOTO,X,XDT,XXX,NAME
+5 NEW PARMS
+6 ;S FACID=$$SITE^VASITE
+7 DO MSH
+8 DO QRD
+9 DO QRF
+10 DO SEND
+11 QUIT
+12 ;
MSH ;SET VARIABLES FOR THE MSH SEGMENT
+1 NEW PARMS
KILL ^TMP("QRY")
+2 SET PARMS("COUNTRY")="USA"
+3 SET PARMS("MESSAGE TYPE")="QRY"
+4 SET PARMS("EVENT")="R02"
+5 SET PARMS("VERSION")="2.3"
+6 SET PARMS("MESSAGE STRUCTURE")="QRY_R02"
+7 SET MSG="^TMP("_"QRY"
+8 SET X=$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
+9 QUIT
+10 ;
QRD ;BUILD THE QRD SEGMENT
+1 SET VALUE="QRD"
SET FIELD=0
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+2 SET %P1=$$NOW^XLFDT()
SET %P1=$$FMTHL7^XLFDT(%P1)
+3 SET VALUE=%P1
SET FIELD=1
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+4 SET VALUE=1
SET FIELD=2
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+5 SET VALUE=1
SET FIELD=3
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+6 ;Need to speak with VDIF about this not being available
+7 ;S X=FACID_" A"
+8 ;S X=$O(^HLB("B",X),-1)
+9 ;S X=$O(^HLB("B",X,0))
+10 ;S QRYNUM=X+1
+11 ;S VALUE=$G(QRYNUM),FIELD=4 D SET^HLOAPI(.SEG,VALUE,FIELD)
+12 SET VALUE=1
SET FIELD=7
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+13 SET NAME=$$GET1^DIQ(2,DFN_",",.01)
+14 SET VALUE=$PIECE(NAME,",",1)
SET FIELD=8
DO SET^HLOAPI(.SEG,VALUE,FIELD,1)
+15 SET VALUE=$PIECE(NAME,",",2)
SET FIELD=8
DO SET^HLOAPI(.SEG,VALUE,FIELD,2)
+16 SET ICN=$$ICN^IBARXMU(DFN)
+17 SET VALUE=ICN
SET FIELD=9
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+18 SET VALUE=""
SET FIELD=10
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+19 SET FIELD=11
+20 SET VALUE=$EXTRACT(IBDT,4,5)
DO SET^HLOAPI(.SEG,VALUE,FIELD,1)
+21 SET VALUE=($EXTRACT(IBDT,1,3)+1700)
DO SET^HLOAPI(.SEG,VALUE,FIELD,2)
+22 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
+23 QUIT
+24 ;
QRF ;
+1 SET FIELD=0
SET VALUE="QRF"
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+2 SET FIELD=1
SET VALUE="IBARXC-TRANS"
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+3 ;Last 4 of SSN
SET FIELD=4
SET X=$$GET1^DIQ(2,DFN_",",.09)
SET VALUE=$EXTRACT(X,$LENGTH(X)-3,$LENGTH(X))
DO SET^HLOAPI(.SEG,VALUE,FIELD)
+4 SET X=$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
+5 QUIT
+6 ;
SEND ;SEND THE MESSAGE
+1 SET PARMS("SENDING APPLICATION")="IBARXC-QRY"
+2 SET WHOTO("RECEIVING APPLICATION")="IBARXC-QRYRESP"
+3 SET WHOTO("STATION NUMBER")="200CRNR"
+4 SET WHOTO("MIDDLEWARE LINK NAME")="IBARXCVDF"
+5 SET XXX=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
+6 HANG 20
+7 QUIT
+8 ;
