RORHL21 ;BPOIFO/ACS - HL7 PURCHASED CARE: ZIN,ZSV,ZRX ;8/23/10
;;1.5;CLINICAL CASE REGISTRIES;**14,19**;Feb 17, 2006;Build 43
;
; This routine uses the following IAs:
;
; #5409 File 162.11 (controlled)
; #5107 Files 162.02, 162.03 (controlled)
; #5104 File 162.4 (controlled)
; #4533 DATA^PSS50 (supported)
; #XXXX File 162.5 (private - approval in progress)
; #5747 $$CSI^ICDEX (controlled)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System
;******************************************************************************
;******************************************************************************
;
Q
;
;***** SEARCH FOR PURCHASED CARE
;
; RORDFN DFN of the patient in the PATIENT file (#2)
;.DXDTS Reference to a local variable where the
; data extraction time frames are stored.
;
; Return Values:
; 0 Ok
;
EN1(RORDFN,DXDTS) ;DATA AREA = 20
N IDX,RORSTDT,RORENDT
S IDX=0
F S IDX=$O(DXDTS(20,IDX)) Q:IDX'>0 D
. S RORSTDT=$P(DXDTS(20,IDX),U),RORENDT=$P(DXDTS(20,IDX),U,2)
. D EN2(RORDFN,RORSTDT,RORENDT) ;get purchased care data for patient
Q 0
;
;***** LOOP THROUGH PURCHASED CARE DATA
;Input
; RORDFN DFN of the patient in the PATIENT file (#2)
; RORSTDT Start date of CCR extract
; RORENDT End date of CCR extract
;
EN2(RORDFN,RORSTDT,RORENDT) ;
N CS D ECH^RORHL7(.CS) ;get component separator
N SCS D ECH^RORHL7(,.SCS) ;get sub-component separator
N RPS D ECH^RORHL7(,,.RPS) ;get repetition separator
;
;GET INPATIENT DATA FROM FEE BASIS INVOICE FILE #162.5
;Date Finalized is used to determine inclusion for HL7 message
N RORIP,IPIEN,IENS,RORDATA,RORERR,DATA7078,ERR7078,FINALDT,PREPTR,RORICDFILE,RORICDVER,RORFLD
S IPIEN=0
F S IPIEN=$O(^FBAAI("D",RORDFN,IPIEN)) Q:'IPIEN D ;DFN x-ref
. K RORIP ;clean out previous data
. S RORIP("IEN")=IPIEN
. S IENS=IPIEN_","
. K RORDATA,RORERR D GETS^DIQ(162.5,IENS,"4;5;6;6.5;6.6;8;19;24;30;31;32;33;34;40;41;42;43;44;54","IE","RORDATA","RORERR")
. S FINALDT=$G(RORDATA(162.5,IENS,19,"I")) ;Date finalized
. Q:'FINALDT
. Q:((FINALDT<RORSTDT)!(FINALDT>RORENDT)) ;quit if outside extract range
. S RORIP("FINALDT")=$G(FINALDT)
. S PREPTR=$G(RORDATA(162.5,IENS,4,"I")) ;Pre-authorization pointer
. I $G(PREPTR)["FB7078" S PREPTR=+PREPTR I $G(PREPTR)>0 D
.. N IENS7078 S IENS7078=PREPTR_","
.. K DATA7078,ERR7078 D GETS^DIQ(162.4,IENS7078,"3.5;4.5","I","DATA7078","ERR7078") ;DBIA 5104 (controlled
.. S RORIP("ADMDT")=$G(DATA7078(162.4,IENS7078,3.5,"I")) ;Date of admission
.. S RORIP("DISDT")=$G(DATA7078(162.4,IENS7078,4.5,"I")) ;Date of discharge
. S RORIP("TRFROMDT")=$G(RORDATA(162.5,IENS,5,"I")) ;Treatement 'from' date
. S RORIP("TRTODT")=$G(RORDATA(162.5,IENS,6,"I")) ;Treatment 'to' date
. S RORIP("DISTYPE")=$G(RORDATA(162.5,IENS,6.5,"I")) ;Discharge type code
. S RORIP("PAID")=$G(RORDATA(162.5,IENS,8,"I")) ;Amount paid
. S RORIP("BILLED")=$G(RORDATA(162.5,IENS,6.6,"I")) ;Billed charges
. S RORIP("DISDRG")=$G(RORDATA(162.5,IENS,24,"E")) ;Discharge DRG
. S RORIP("COVDAYS")=$G(RORDATA(162.5,IENS,54,"E")) ;covered days
. S RORIP("ICD1")=$G(RORDATA(162.5,IENS,30,"E")) ;ICD 1
. S RORIP("ICD2")=$G(RORDATA(162.5,IENS,31,"E")) ;ICD 2
. S RORIP("ICD3")=$G(RORDATA(162.5,IENS,32,"E")) ;ICD 3
. S RORIP("ICD4")=$G(RORDATA(162.5,IENS,33,"E")) ;ICD 4
. S RORIP("ICD5")=$G(RORDATA(162.5,IENS,34,"E")) ;ICD 5
. S RORIP("PROC1")=$G(RORDATA(162.5,IENS,40,"E")) ;Procedure 1
. S RORIP("PROC2")=$G(RORDATA(162.5,IENS,41,"E")) ;Procedure 2
. S RORIP("PROC3")=$G(RORDATA(162.5,IENS,42,"E")) ;Procedure 3
. S RORIP("PROC4")=$G(RORDATA(162.5,IENS,43,"E")) ;Procedure 4
. S RORIP("PROC5")=$G(RORDATA(162.5,IENS,44,"E")) ;Procedure 5
. F RORFLD=30:1:34,40:1:44 D Q:RORICDVER]""
. . S RORICDFILE=$S(RORFLD>39:80.1,1:80)
. . S RORICDVER=$$ICDVER(RORICDFILE,$G(RORDATA(162.5,IENS,RORFLD,"I")))
. S RORIP("ICDVERSION")=RORICDVER
. D ZIN(.RORIP)
;
;---GET OUTPATIENT DATA FROM FEE BASIS PAYMENT FILE #162
;Date Finalized is used to determine inclusion for HL7 message
N RORVENDOR ;authorization vendor IEN
N RORITDT ;initial treatment date IEN
N RORSVC ;service IEN
N IENS,FINALDT
S RORVENDOR=0 F S RORVENDOR=$O(^FBAAC(RORDFN,1,RORVENDOR)) Q:'RORVENDOR D
. ;go to 'initial treatment date' level and get requested data
. S RORITDT=0 F S RORITDT=$O(^FBAAC(RORDFN,1,RORVENDOR,1,RORITDT)) Q:'RORITDT D
.. N ROROP ;array to hold outpatient data
.. K IENS S IENS=RORITDT_","_RORVENDOR_","_RORDFN_","
.. K RORDATA,RORERR D GETS^DIQ(162.02,IENS,".01;1.5","IE","RORDATA","RORERR")
.. S ROROP("TRDT")=$G(RORDATA(162.02,IENS,.01,"I")) ;initial treatment date
.. S ROROP("FEEPGM")=$G(RORDATA(162.02,IENS,1.5,"I")) ;fee program
.. ;go to 'service provided' level and get requested data
.. S RORSVC=0 F S RORSVC=$O(^FBAAC(RORDFN,1,RORVENDOR,1,RORITDT,1,RORSVC)) Q:'RORSVC D
... N IENSVC S IENSVC=RORSVC_","_RORITDT_","_RORVENDOR_","_RORDFN_","
... K RORDATA,RORERR D GETS^DIQ(162.03,IENSVC,".01;5;16;28;30","IE","RORDATA","RORERR")
... S FINALDT=$G(RORDATA(162.03,IENSVC,5,"I")) ;date finalized
... Q:(($G(FINALDT)<RORSTDT)!($G(FINALDT)>(RORENDT))) ;quit if outside date range
... S ROROP("FINALDT")=FINALDT
... S ROROP("SVC")=$G(RORDATA(162.03,IENSVC,.01,"E")) ;service provided
... S ROROP("POV")=$G(RORDATA(162.03,IENSVC,16,"E")) ;purpose of visit
... S ROROP("PDIAG")=$G(RORDATA(162.03,IENSVC,28,"E")) ;primary diagnosis
... S ROROP("ICDVERSION")=$$ICDVER(80,$G(RORDATA(162.03,IENSVC,28,"I"))) ;ICD version
... S ROROP("POS")=$G(RORDATA(162.03,IENSVC,30,"E")) ;place of service
... S ROROP("IEN")=RORDFN_"-"_RORVENDOR_"-"_RORITDT_"-"_RORSVC
... D ZSV(.ROROP)
;
;
;---GET DRUG DATA FROM FEE BASIS PHARMACY INVOICE FILE #162.1
;Date Certified for Payment (RORDCP) is used to determine inclusion in HL7 message
N RORRX,RORDCP,RXIEN0,RXIEN1
S RORDCP=(RORSTDT-.01) F S RORDCP=$O(^FBAA(162.1,"AA",RORDCP)) Q:'RORDCP Q:(RORDCP>RORENDT) D
. S RXIEN0=0
. F S RXIEN0=$O(^FBAA(162.1,"AA",RORDCP,RORDFN,RXIEN0)) Q:'RXIEN0 D
.. S RXIEN1=0 F S RXIEN1=$O(^FBAA(162.1,"AA",RORDCP,RORDFN,RXIEN0,RXIEN1)) Q:'RXIEN1 D
... K RORRX ;clean out previous data
... S RORRX("NUM")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,1) ;rx number
... S RORRX("NAME")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,2) ;drug name
... Q:($G(RORRX("NAME"))="") ;drug name is required
... S RORRX("FILLDT")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,3) ;date filled
... S RORRX("GENIEN")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,10) ;generic drug IEN
... I $G(RORRX("GENIEN")) D ;get generic drug name
.... D DATA^PSS50(RORRX("GENIEN"),,,,,"RORDRUG")
.... S RORRX("GENERIC")=$G(^TMP($J,"RORDRUG",RORRX("GENIEN"),.01)) ;generic drug name
.... K ^TMP($J,"RORDRUG")
... S RORRX("STRENGTH")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,12) ;drug strength
... S RORRX("QUANTITY")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,13) ;drug quantity
... S RORRX("IEN1")=$G(RXIEN0) S RORRX("IEN2")=$G(RXIEN1)
... D ZRX(.RORRX)
Q
;
;
;***** ZIN SEGMENT BUILDER
;
;Input
; RORIP Array with inpatient data
;
ZIN(RORIP) ;
;--- Segment type
N RORSEG S RORSEG(0)="ZIN"
;ZIN-1: Unique Key (IEN)
S RORSEG(1)=$G(RORIP("IEN"))
;ZIN-2: Treatment 'from' date
I $G(RORIP("TRFROMDT")) S RORSEG(2)=$$FM2HL^RORHL7(RORIP("TRFROMDT"))
;ZIN-3: Treatment 'to' date
I $G(RORIP("TRTODT")) S RORSEG(3)=$$FM2HL^RORHL7(RORIP("TRTODT"))
;ZIN-4: Discharge Type code
S RORSEG(4)=$G(RORIP("DISTYPE"))
;ZIN-5: Amount Billed
S RORSEG(5)=$G(RORIP("BILLED"))
;ZIN-6: Amount Paid
S RORSEG(6)=$G(RORIP("PAID"))
;ZIN-7: Date Finalized
I $G(RORIP("FINALDT")) S RORSEG(7)=$$FM2HL^RORHL7(RORIP("FINALDT"))
;ZIN-8: Discharge DRG
S RORSEG(8)=$G(RORIP("DISDRG"))
;ZIN-9: Date of Admission
I $G(RORIP("ADMDT")) S RORSEG(9)=$$FM2HL^RORHL7(RORIP("ADMDT"))
;ZIN-10: Date of Discharge
I $G(RORIP("DISDT")) S RORSEG(10)=$$FM2HL^RORHL7(RORIP("DISDT"))
;ZIN-11: Covered Days
S RORSEG(11)=$G(RORIP("COVDAYS"))
;ZIN-12: ICD 1
S RORSEG(12)=$G(RORIP("ICD1"))
;ZIN-13: ICD 2
S RORSEG(13)=$G(RORIP("ICD2"))
;ZIN-14: ICD 3
S RORSEG(14)=$G(RORIP("ICD3"))
;ZIN-15: ICD 4
S RORSEG(15)=$G(RORIP("ICD4"))
;ZIN-16: ICD 5
S RORSEG(16)=$G(RORIP("ICD5"))
;ZIN-17: Procedure 1
S RORSEG(17)=$G(RORIP("PROC1"))
;ZIN-18: Procedure 2
S RORSEG(18)=$G(RORIP("PROC2"))
;ZIN-19: Procedure 3
S RORSEG(19)=$G(RORIP("PROC3"))
;ZIN-20: Procedure 4
S RORSEG(20)=$G(RORIP("PROC4"))
;ZIN-21: Procedure 5
S RORSEG(21)=$G(RORIP("PROC5"))
;ZIN-22: ICD Version
S RORSEG(22)=$G(RORIP("ICDVERSION"))
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
;
;***** ZSV SEGMENT BUILDER
;
;Input
; ROROP Array with outpatient data
;
ZSV(ROROP) ;
;--- Segment type
N RORSEG S RORSEG(0)="ZSV"
;ZSV-1: Unique key (IEN)
S RORSEG(1)=$G(ROROP("IEN"))
;ZSV-2: Initial Treatment Date
I $G(ROROP("TRDT")) S RORSEG(2)=$$FM2HL^RORHL7(ROROP("TRDT"))
;ZSV-3: Fee Program IEN
S RORSEG(3)=$G(ROROP("FEEPGM"))
;ZSV-4: Service Provided
S RORSEG(4)=$G(ROROP("SVC"))
;ZSV-5: Purpose of Visit
S RORSEG(5)=$G(ROROP("POV"))
;ZSV-6: Primary Diagnosis
S RORSEG(6)=$G(ROROP("PDIAG"))
;ZSV-7: Place of Service
S RORSEG(7)=$G(ROROP("POS"))
;ZSV-8: ICD Version
S RORSEG(8)=$G(ROROP("ICDVERSION"))
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
;
;***** ZRX SEGMENT BUILDER
;
;Input
; RORRX Array with drug data
;
ZRX(RORRX) ;
;--- Segment type
N RORSEG S RORSEG(0)="ZRX"
;ZRX-1: Unique key (IEN)
S RORSEG(1)=$G(RORRX("IEN1"))_"-"_$G(RORRX("IEN2"))
;ZRX-2: Rx Number
S RORSEG(2)=$G(RORRX("NUM"))
;ZRX-3: Date Rx Filled
I $G(RORRX("FILLDT")) S RORSEG(3)=$$FM2HL^RORHL7(RORRX("FILLDT"))
;ZRX-4: Drug Name
S RORSEG(4)=$G(RORRX("NAME"))
;ZRX-5: Generic Drug Name
S RORSEG(5)=$G(RORRX("GENERIC"))
;ZRX-6: Drug Strength
S RORSEG(6)=$G(RORRX("STRENGTH"))
;ZRX-7: Drug Quantity
S RORSEG(7)=$G(RORRX("QUANTITY"))
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
;
;***** ICD VERSION
;
;Input
; RORICDFILE - 80 or 80.1
; RORICDIEN - ICD IEN
;
ICDVER(RORICDFILE,RORICDIEN) ;
N RORICDSYS
S RORICDSYS=$$CSI^ICDEX($G(RORICDFILE),$G(RORICDIEN))
I (RORICDSYS=1)!(RORICDSYS=2) Q "I9^ICD-9^99VA80_4"
I (RORICDSYS=30)!(RORICDSYS=31) Q "I10^ICD-10^99VA80_4"
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL21 10958 printed Dec 13, 2024@01:42:06 Page 2
RORHL21 ;BPOIFO/ACS - HL7 PURCHASED CARE: ZIN,ZSV,ZRX ;8/23/10
+1 ;;1.5;CLINICAL CASE REGISTRIES;**14,19**;Feb 17, 2006;Build 43
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #5409 File 162.11 (controlled)
+6 ; #5107 Files 162.02, 162.03 (controlled)
+7 ; #5104 File 162.4 (controlled)
+8 ; #4533 DATA^PSS50 (supported)
+9 ; #XXXX File 162.5 (private - approval in progress)
+10 ; #5747 $$CSI^ICDEX (controlled)
+11 ;
+12 ;******************************************************************************
+13 ;******************************************************************************
+14 ; --- ROUTINE MODIFICATION LOG ---
+15 ;
+16 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+17 ;----------- ---------- ----------- ----------------------------------------
+18 ;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System
+19 ;******************************************************************************
+20 ;******************************************************************************
+21 ;
+22 QUIT
+23 ;
+24 ;***** SEARCH FOR PURCHASED CARE
+25 ;
+26 ; RORDFN DFN of the patient in the PATIENT file (#2)
+27 ;.DXDTS Reference to a local variable where the
+28 ; data extraction time frames are stored.
+29 ;
+30 ; Return Values:
+31 ; 0 Ok
+32 ;
EN1(RORDFN,DXDTS) ;DATA AREA = 20
+1 NEW IDX,RORSTDT,RORENDT
+2 SET IDX=0
+3 FOR
SET IDX=$ORDER(DXDTS(20,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+4 SET RORSTDT=$PIECE(DXDTS(20,IDX),U)
SET RORENDT=$PIECE(DXDTS(20,IDX),U,2)
+5 ;get purchased care data for patient
DO EN2(RORDFN,RORSTDT,RORENDT)
End DoDot:1
+6 QUIT 0
+7 ;
+8 ;***** LOOP THROUGH PURCHASED CARE DATA
+9 ;Input
+10 ; RORDFN DFN of the patient in the PATIENT file (#2)
+11 ; RORSTDT Start date of CCR extract
+12 ; RORENDT End date of CCR extract
+13 ;
EN2(RORDFN,RORSTDT,RORENDT) ;
+1 ;get component separator
NEW CS
DO ECH^RORHL7(.CS)
+2 ;get sub-component separator
NEW SCS
DO ECH^RORHL7(,.SCS)
+3 ;get repetition separator
NEW RPS
DO ECH^RORHL7(,,.RPS)
+4 ;
+5 ;GET INPATIENT DATA FROM FEE BASIS INVOICE FILE #162.5
+6 ;Date Finalized is used to determine inclusion for HL7 message
+7 NEW RORIP,IPIEN,IENS,RORDATA,RORERR,DATA7078,ERR7078,FINALDT,PREPTR,RORICDFILE,RORICDVER,RORFLD
+8 SET IPIEN=0
+9 ;DFN x-ref
FOR
SET IPIEN=$ORDER(^FBAAI("D",RORDFN,IPIEN))
if 'IPIEN
QUIT
Begin DoDot:1
+10 ;clean out previous data
KILL RORIP
+11 SET RORIP("IEN")=IPIEN
+12 SET IENS=IPIEN_","
+13 KILL RORDATA,RORERR
DO GETS^DIQ(162.5,IENS,"4;5;6;6.5;6.6;8;19;24;30;31;32;33;34;40;41;42;43;44;54","IE","RORDATA","RORERR")
+14 ;Date finalized
SET FINALDT=$GET(RORDATA(162.5,IENS,19,"I"))
+15 if 'FINALDT
QUIT
+16 ;quit if outside extract range
if ((FINALDT<RORSTDT)!(FINALDT>RORENDT))
QUIT
+17 SET RORIP("FINALDT")=$GET(FINALDT)
+18 ;Pre-authorization pointer
SET PREPTR=$GET(RORDATA(162.5,IENS,4,"I"))
+19 IF $GET(PREPTR)["FB7078"
SET PREPTR=+PREPTR
IF $GET(PREPTR)>0
Begin DoDot:2
+20 NEW IENS7078
SET IENS7078=PREPTR_","
+21 ;DBIA 5104 (controlled
KILL DATA7078,ERR7078
DO GETS^DIQ(162.4,IENS7078,"3.5;4.5","I","DATA7078","ERR7078")
+22 ;Date of admission
SET RORIP("ADMDT")=$GET(DATA7078(162.4,IENS7078,3.5,"I"))
+23 ;Date of discharge
SET RORIP("DISDT")=$GET(DATA7078(162.4,IENS7078,4.5,"I"))
End DoDot:2
+24 ;Treatement 'from' date
SET RORIP("TRFROMDT")=$GET(RORDATA(162.5,IENS,5,"I"))
+25 ;Treatment 'to' date
SET RORIP("TRTODT")=$GET(RORDATA(162.5,IENS,6,"I"))
+26 ;Discharge type code
SET RORIP("DISTYPE")=$GET(RORDATA(162.5,IENS,6.5,"I"))
+27 ;Amount paid
SET RORIP("PAID")=$GET(RORDATA(162.5,IENS,8,"I"))
+28 ;Billed charges
SET RORIP("BILLED")=$GET(RORDATA(162.5,IENS,6.6,"I"))
+29 ;Discharge DRG
SET RORIP("DISDRG")=$GET(RORDATA(162.5,IENS,24,"E"))
+30 ;covered days
SET RORIP("COVDAYS")=$GET(RORDATA(162.5,IENS,54,"E"))
+31 ;ICD 1
SET RORIP("ICD1")=$GET(RORDATA(162.5,IENS,30,"E"))
+32 ;ICD 2
SET RORIP("ICD2")=$GET(RORDATA(162.5,IENS,31,"E"))
+33 ;ICD 3
SET RORIP("ICD3")=$GET(RORDATA(162.5,IENS,32,"E"))
+34 ;ICD 4
SET RORIP("ICD4")=$GET(RORDATA(162.5,IENS,33,"E"))
+35 ;ICD 5
SET RORIP("ICD5")=$GET(RORDATA(162.5,IENS,34,"E"))
+36 ;Procedure 1
SET RORIP("PROC1")=$GET(RORDATA(162.5,IENS,40,"E"))
+37 ;Procedure 2
SET RORIP("PROC2")=$GET(RORDATA(162.5,IENS,41,"E"))
+38 ;Procedure 3
SET RORIP("PROC3")=$GET(RORDATA(162.5,IENS,42,"E"))
+39 ;Procedure 4
SET RORIP("PROC4")=$GET(RORDATA(162.5,IENS,43,"E"))
+40 ;Procedure 5
SET RORIP("PROC5")=$GET(RORDATA(162.5,IENS,44,"E"))
+41 FOR RORFLD=30:1:34,40:1:44
Begin DoDot:2
+42 SET RORICDFILE=$SELECT(RORFLD>39:80.1,1:80)
+43 SET RORICDVER=$$ICDVER(RORICDFILE,$GET(RORDATA(162.5,IENS,RORFLD,"I")))
End DoDot:2
if RORICDVER]""
QUIT
+44 SET RORIP("ICDVERSION")=RORICDVER
+45 DO ZIN(.RORIP)
End DoDot:1
+46 ;
+47 ;---GET OUTPATIENT DATA FROM FEE BASIS PAYMENT FILE #162
+48 ;Date Finalized is used to determine inclusion for HL7 message
+49 ;authorization vendor IEN
NEW RORVENDOR
+50 ;initial treatment date IEN
NEW RORITDT
+51 ;service IEN
NEW RORSVC
+52 NEW IENS,FINALDT
+53 SET RORVENDOR=0
FOR
SET RORVENDOR=$ORDER(^FBAAC(RORDFN,1,RORVENDOR))
if 'RORVENDOR
QUIT
Begin DoDot:1
+54 ;go to 'initial treatment date' level and get requested data
+55 SET RORITDT=0
FOR
SET RORITDT=$ORDER(^FBAAC(RORDFN,1,RORVENDOR,1,RORITDT))
if 'RORITDT
QUIT
Begin DoDot:2
+56 ;array to hold outpatient data
NEW ROROP
+57 KILL IENS
SET IENS=RORITDT_","_RORVENDOR_","_RORDFN_","
+58 KILL RORDATA,RORERR
DO GETS^DIQ(162.02,IENS,".01;1.5","IE","RORDATA","RORERR")
+59 ;initial treatment date
SET ROROP("TRDT")=$GET(RORDATA(162.02,IENS,.01,"I"))
+60 ;fee program
SET ROROP("FEEPGM")=$GET(RORDATA(162.02,IENS,1.5,"I"))
+61 ;go to 'service provided' level and get requested data
+62 SET RORSVC=0
FOR
SET RORSVC=$ORDER(^FBAAC(RORDFN,1,RORVENDOR,1,RORITDT,1,RORSVC))
if 'RORSVC
QUIT
Begin DoDot:3
+63 NEW IENSVC
SET IENSVC=RORSVC_","_RORITDT_","_RORVENDOR_","_RORDFN_","
+64 KILL RORDATA,RORERR
DO GETS^DIQ(162.03,IENSVC,".01;5;16;28;30","IE","RORDATA","RORERR")
+65 ;date finalized
SET FINALDT=$GET(RORDATA(162.03,IENSVC,5,"I"))
+66 ;quit if outside date range
if (($GET(FINALDT)<RORSTDT)!($GET(FINALDT)>(RORENDT)))
QUIT
+67 SET ROROP("FINALDT")=FINALDT
+68 ;service provided
SET ROROP("SVC")=$GET(RORDATA(162.03,IENSVC,.01,"E"))
+69 ;purpose of visit
SET ROROP("POV")=$GET(RORDATA(162.03,IENSVC,16,"E"))
+70 ;primary diagnosis
SET ROROP("PDIAG")=$GET(RORDATA(162.03,IENSVC,28,"E"))
+71 ;ICD version
SET ROROP("ICDVERSION")=$$ICDVER(80,$GET(RORDATA(162.03,IENSVC,28,"I")))
+72 ;place of service
SET ROROP("POS")=$GET(RORDATA(162.03,IENSVC,30,"E"))
+73 SET ROROP("IEN")=RORDFN_"-"_RORVENDOR_"-"_RORITDT_"-"_RORSVC
+74 DO ZSV(.ROROP)
End DoDot:3
End DoDot:2
End DoDot:1
+75 ;
+76 ;
+77 ;---GET DRUG DATA FROM FEE BASIS PHARMACY INVOICE FILE #162.1
+78 ;Date Certified for Payment (RORDCP) is used to determine inclusion in HL7 message
+79 NEW RORRX,RORDCP,RXIEN0,RXIEN1
+80 SET RORDCP=(RORSTDT-.01)
FOR
SET RORDCP=$ORDER(^FBAA(162.1,"AA",RORDCP))
if 'RORDCP
QUIT
if (RORDCP>RORENDT)
QUIT
Begin DoDot:1
+81 SET RXIEN0=0
+82 FOR
SET RXIEN0=$ORDER(^FBAA(162.1,"AA",RORDCP,RORDFN,RXIEN0))
if 'RXIEN0
QUIT
Begin DoDot:2
+83 SET RXIEN1=0
FOR
SET RXIEN1=$ORDER(^FBAA(162.1,"AA",RORDCP,RORDFN,RXIEN0,RXIEN1))
if 'RXIEN1
QUIT
Begin DoDot:3
+84 ;clean out previous data
KILL RORRX
+85 ;rx number
SET RORRX("NUM")=$PIECE($GET(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,1)
+86 ;drug name
SET RORRX("NAME")=$PIECE($GET(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,2)
+87 ;drug name is required
if ($GET(RORRX("NAME"))="")
QUIT
+88 ;date filled
SET RORRX("FILLDT")=$PIECE($GET(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,3)
+89 ;generic drug IEN
SET RORRX("GENIEN")=$PIECE($GET(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,10)
+90 ;get generic drug name
IF $GET(RORRX("GENIEN"))
Begin DoDot:4
+91 DO DATA^PSS50(RORRX("GENIEN"),,,,,"RORDRUG")
+92 ;generic drug name
SET RORRX("GENERIC")=$GET(^TMP($JOB,"RORDRUG",RORRX("GENIEN"),.01))
+93 KILL ^TMP($JOB,"RORDRUG")
End DoDot:4
+94 ;drug strength
SET RORRX("STRENGTH")=$PIECE($GET(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,12)
+95 ;drug quantity
SET RORRX("QUANTITY")=$PIECE($GET(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,13)
+96 SET RORRX("IEN1")=$GET(RXIEN0)
SET RORRX("IEN2")=$GET(RXIEN1)
+97 DO ZRX(.RORRX)
End DoDot:3
End DoDot:2
End DoDot:1
+98 QUIT
+99 ;
+100 ;
+101 ;***** ZIN SEGMENT BUILDER
+102 ;
+103 ;Input
+104 ; RORIP Array with inpatient data
+105 ;
ZIN(RORIP) ;
+1 ;--- Segment type
+2 NEW RORSEG
SET RORSEG(0)="ZIN"
+3 ;ZIN-1: Unique Key (IEN)
+4 SET RORSEG(1)=$GET(RORIP("IEN"))
+5 ;ZIN-2: Treatment 'from' date
+6 IF $GET(RORIP("TRFROMDT"))
SET RORSEG(2)=$$FM2HL^RORHL7(RORIP("TRFROMDT"))
+7 ;ZIN-3: Treatment 'to' date
+8 IF $GET(RORIP("TRTODT"))
SET RORSEG(3)=$$FM2HL^RORHL7(RORIP("TRTODT"))
+9 ;ZIN-4: Discharge Type code
+10 SET RORSEG(4)=$GET(RORIP("DISTYPE"))
+11 ;ZIN-5: Amount Billed
+12 SET RORSEG(5)=$GET(RORIP("BILLED"))
+13 ;ZIN-6: Amount Paid
+14 SET RORSEG(6)=$GET(RORIP("PAID"))
+15 ;ZIN-7: Date Finalized
+16 IF $GET(RORIP("FINALDT"))
SET RORSEG(7)=$$FM2HL^RORHL7(RORIP("FINALDT"))
+17 ;ZIN-8: Discharge DRG
+18 SET RORSEG(8)=$GET(RORIP("DISDRG"))
+19 ;ZIN-9: Date of Admission
+20 IF $GET(RORIP("ADMDT"))
SET RORSEG(9)=$$FM2HL^RORHL7(RORIP("ADMDT"))
+21 ;ZIN-10: Date of Discharge
+22 IF $GET(RORIP("DISDT"))
SET RORSEG(10)=$$FM2HL^RORHL7(RORIP("DISDT"))
+23 ;ZIN-11: Covered Days
+24 SET RORSEG(11)=$GET(RORIP("COVDAYS"))
+25 ;ZIN-12: ICD 1
+26 SET RORSEG(12)=$GET(RORIP("ICD1"))
+27 ;ZIN-13: ICD 2
+28 SET RORSEG(13)=$GET(RORIP("ICD2"))
+29 ;ZIN-14: ICD 3
+30 SET RORSEG(14)=$GET(RORIP("ICD3"))
+31 ;ZIN-15: ICD 4
+32 SET RORSEG(15)=$GET(RORIP("ICD4"))
+33 ;ZIN-16: ICD 5
+34 SET RORSEG(16)=$GET(RORIP("ICD5"))
+35 ;ZIN-17: Procedure 1
+36 SET RORSEG(17)=$GET(RORIP("PROC1"))
+37 ;ZIN-18: Procedure 2
+38 SET RORSEG(18)=$GET(RORIP("PROC2"))
+39 ;ZIN-19: Procedure 3
+40 SET RORSEG(19)=$GET(RORIP("PROC3"))
+41 ;ZIN-20: Procedure 4
+42 SET RORSEG(20)=$GET(RORIP("PROC4"))
+43 ;ZIN-21: Procedure 5
+44 SET RORSEG(21)=$GET(RORIP("PROC5"))
+45 ;ZIN-22: ICD Version
+46 SET RORSEG(22)=$GET(RORIP("ICDVERSION"))
+47 ;
+48 ;--- Store the segment
+49 DO ADDSEG^RORHL7(.RORSEG)
+50 QUIT
+51 ;
+52 ;***** ZSV SEGMENT BUILDER
+53 ;
+54 ;Input
+55 ; ROROP Array with outpatient data
+56 ;
ZSV(ROROP) ;
+1 ;--- Segment type
+2 NEW RORSEG
SET RORSEG(0)="ZSV"
+3 ;ZSV-1: Unique key (IEN)
+4 SET RORSEG(1)=$GET(ROROP("IEN"))
+5 ;ZSV-2: Initial Treatment Date
+6 IF $GET(ROROP("TRDT"))
SET RORSEG(2)=$$FM2HL^RORHL7(ROROP("TRDT"))
+7 ;ZSV-3: Fee Program IEN
+8 SET RORSEG(3)=$GET(ROROP("FEEPGM"))
+9 ;ZSV-4: Service Provided
+10 SET RORSEG(4)=$GET(ROROP("SVC"))
+11 ;ZSV-5: Purpose of Visit
+12 SET RORSEG(5)=$GET(ROROP("POV"))
+13 ;ZSV-6: Primary Diagnosis
+14 SET RORSEG(6)=$GET(ROROP("PDIAG"))
+15 ;ZSV-7: Place of Service
+16 SET RORSEG(7)=$GET(ROROP("POS"))
+17 ;ZSV-8: ICD Version
+18 SET RORSEG(8)=$GET(ROROP("ICDVERSION"))
+19 ;
+20 ;--- Store the segment
+21 DO ADDSEG^RORHL7(.RORSEG)
+22 QUIT
+23 ;
+24 ;***** ZRX SEGMENT BUILDER
+25 ;
+26 ;Input
+27 ; RORRX Array with drug data
+28 ;
ZRX(RORRX) ;
+1 ;--- Segment type
+2 NEW RORSEG
SET RORSEG(0)="ZRX"
+3 ;ZRX-1: Unique key (IEN)
+4 SET RORSEG(1)=$GET(RORRX("IEN1"))_"-"_$GET(RORRX("IEN2"))
+5 ;ZRX-2: Rx Number
+6 SET RORSEG(2)=$GET(RORRX("NUM"))
+7 ;ZRX-3: Date Rx Filled
+8 IF $GET(RORRX("FILLDT"))
SET RORSEG(3)=$$FM2HL^RORHL7(RORRX("FILLDT"))
+9 ;ZRX-4: Drug Name
+10 SET RORSEG(4)=$GET(RORRX("NAME"))
+11 ;ZRX-5: Generic Drug Name
+12 SET RORSEG(5)=$GET(RORRX("GENERIC"))
+13 ;ZRX-6: Drug Strength
+14 SET RORSEG(6)=$GET(RORRX("STRENGTH"))
+15 ;ZRX-7: Drug Quantity
+16 SET RORSEG(7)=$GET(RORRX("QUANTITY"))
+17 ;
+18 ;--- Store the segment
+19 DO ADDSEG^RORHL7(.RORSEG)
+20 QUIT
+21 ;
+22 ;***** ICD VERSION
+23 ;
+24 ;Input
+25 ; RORICDFILE - 80 or 80.1
+26 ; RORICDIEN - ICD IEN
+27 ;
ICDVER(RORICDFILE,RORICDIEN) ;
+1 NEW RORICDSYS
+2 SET RORICDSYS=$$CSI^ICDEX($GET(RORICDFILE),$GET(RORICDIEN))
+3 IF (RORICDSYS=1)!(RORICDSYS=2)
QUIT "I9^ICD-9^99VA80_4"
+4 IF (RORICDSYS=30)!(RORICDSYS=31)
QUIT "I10^ICD-10^99VA80_4"
+5 QUIT ""
