- 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 Feb 18, 2025@23:33:24 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 ;
