Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHL21

RORHL21.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #5409         File 162.11 (controlled)
  1.  ; #5107         Files 162.02, 162.03 (controlled)
  1.  ; #5104         File 162.4 (controlled)
  1.  ; #4533         DATA^PSS50 (supported)
  1.  ; #XXXX         File 162.5 (private - approval in progress)
  1.  ; #5747         $$CSI^ICDEX (controlled)
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*19   MAY  2012   K GUPTA      Support for ICD-10 Coding System
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** SEARCH FOR PURCHASED CARE
  1.  ;
  1.  ; RORDFN        DFN of the patient in the PATIENT file (#2)
  1.  ;.DXDTS         Reference to a local variable where the
  1.  ;               data extraction time frames are stored.
  1.  ;
  1.  ; Return Values:
  1.  ;        0  Ok
  1.  ;
  1. EN1(RORDFN,DXDTS) ;DATA AREA = 20
  1.  N IDX,RORSTDT,RORENDT
  1.  S IDX=0
  1.  F  S IDX=$O(DXDTS(20,IDX))  Q:IDX'>0  D
  1.  . S RORSTDT=$P(DXDTS(20,IDX),U),RORENDT=$P(DXDTS(20,IDX),U,2)
  1.  . D EN2(RORDFN,RORSTDT,RORENDT) ;get purchased care data for patient
  1.  Q 0
  1.  ;
  1.  ;***** LOOP THROUGH PURCHASED CARE DATA
  1.  ;Input
  1.  ; RORDFN        DFN of the patient in the PATIENT file (#2)
  1.  ; RORSTDT       Start date of CCR extract
  1.  ; RORENDT       End date of CCR extract
  1.  ;
  1. EN2(RORDFN,RORSTDT,RORENDT) ;
  1.  N CS D ECH^RORHL7(.CS) ;get component separator
  1.  N SCS D ECH^RORHL7(,.SCS) ;get sub-component separator
  1.  N RPS D ECH^RORHL7(,,.RPS) ;get repetition separator
  1.  ;
  1.  ;GET INPATIENT DATA FROM FEE BASIS INVOICE FILE #162.5
  1.  ;Date Finalized is used to determine inclusion for HL7 message
  1.  N RORIP,IPIEN,IENS,RORDATA,RORERR,DATA7078,ERR7078,FINALDT,PREPTR,RORICDFILE,RORICDVER,RORFLD
  1.  S IPIEN=0
  1.  F  S IPIEN=$O(^FBAAI("D",RORDFN,IPIEN)) Q:'IPIEN  D  ;DFN x-ref
  1.  . K RORIP ;clean out previous data
  1.  . S RORIP("IEN")=IPIEN
  1.  . S IENS=IPIEN_","
  1.  . 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")
  1.  . S FINALDT=$G(RORDATA(162.5,IENS,19,"I")) ;Date finalized
  1.  . Q:'FINALDT
  1.  . Q:((FINALDT<RORSTDT)!(FINALDT>RORENDT))  ;quit if outside extract range
  1.  . S RORIP("FINALDT")=$G(FINALDT)
  1.  . S PREPTR=$G(RORDATA(162.5,IENS,4,"I")) ;Pre-authorization pointer
  1.  . I $G(PREPTR)["FB7078" S PREPTR=+PREPTR I $G(PREPTR)>0 D
  1.  .. N IENS7078 S IENS7078=PREPTR_","
  1.  .. K DATA7078,ERR7078 D GETS^DIQ(162.4,IENS7078,"3.5;4.5","I","DATA7078","ERR7078") ;DBIA 5104 (controlled
  1.  .. S RORIP("ADMDT")=$G(DATA7078(162.4,IENS7078,3.5,"I")) ;Date of admission
  1.  .. S RORIP("DISDT")=$G(DATA7078(162.4,IENS7078,4.5,"I")) ;Date of discharge
  1.  . S RORIP("TRFROMDT")=$G(RORDATA(162.5,IENS,5,"I")) ;Treatement 'from' date
  1.  . S RORIP("TRTODT")=$G(RORDATA(162.5,IENS,6,"I")) ;Treatment 'to' date
  1.  . S RORIP("DISTYPE")=$G(RORDATA(162.5,IENS,6.5,"I")) ;Discharge type code
  1.  . S RORIP("PAID")=$G(RORDATA(162.5,IENS,8,"I")) ;Amount paid
  1.  . S RORIP("BILLED")=$G(RORDATA(162.5,IENS,6.6,"I")) ;Billed charges
  1.  . S RORIP("DISDRG")=$G(RORDATA(162.5,IENS,24,"E")) ;Discharge DRG
  1.  . S RORIP("COVDAYS")=$G(RORDATA(162.5,IENS,54,"E")) ;covered days
  1.  . S RORIP("ICD1")=$G(RORDATA(162.5,IENS,30,"E")) ;ICD 1
  1.  . S RORIP("ICD2")=$G(RORDATA(162.5,IENS,31,"E")) ;ICD 2
  1.  . S RORIP("ICD3")=$G(RORDATA(162.5,IENS,32,"E")) ;ICD 3
  1.  . S RORIP("ICD4")=$G(RORDATA(162.5,IENS,33,"E")) ;ICD 4
  1.  . S RORIP("ICD5")=$G(RORDATA(162.5,IENS,34,"E")) ;ICD 5
  1.  . S RORIP("PROC1")=$G(RORDATA(162.5,IENS,40,"E")) ;Procedure 1
  1.  . S RORIP("PROC2")=$G(RORDATA(162.5,IENS,41,"E")) ;Procedure 2
  1.  . S RORIP("PROC3")=$G(RORDATA(162.5,IENS,42,"E")) ;Procedure 3
  1.  . S RORIP("PROC4")=$G(RORDATA(162.5,IENS,43,"E")) ;Procedure 4
  1.  . S RORIP("PROC5")=$G(RORDATA(162.5,IENS,44,"E")) ;Procedure 5
  1.  . F RORFLD=30:1:34,40:1:44 D  Q:RORICDVER]""
  1.  . . S RORICDFILE=$S(RORFLD>39:80.1,1:80)
  1.  . . S RORICDVER=$$ICDVER(RORICDFILE,$G(RORDATA(162.5,IENS,RORFLD,"I")))
  1.  . S RORIP("ICDVERSION")=RORICDVER
  1.  . D ZIN(.RORIP)
  1.  ;
  1.  ;---GET OUTPATIENT DATA FROM FEE BASIS PAYMENT FILE #162
  1.  ;Date Finalized is used to determine inclusion for HL7 message
  1.  N RORVENDOR ;authorization vendor IEN
  1.  N RORITDT ;initial treatment date IEN
  1.  N RORSVC ;service IEN
  1.  N IENS,FINALDT
  1.  S RORVENDOR=0 F  S RORVENDOR=$O(^FBAAC(RORDFN,1,RORVENDOR)) Q:'RORVENDOR  D
  1.  . ;go to 'initial treatment date' level and get requested data
  1.  . S RORITDT=0 F  S RORITDT=$O(^FBAAC(RORDFN,1,RORVENDOR,1,RORITDT)) Q:'RORITDT  D
  1.  .. N ROROP ;array to hold outpatient data
  1.  .. K IENS S IENS=RORITDT_","_RORVENDOR_","_RORDFN_","
  1.  .. K RORDATA,RORERR D GETS^DIQ(162.02,IENS,".01;1.5","IE","RORDATA","RORERR")
  1.  .. S ROROP("TRDT")=$G(RORDATA(162.02,IENS,.01,"I")) ;initial treatment date
  1.  .. S ROROP("FEEPGM")=$G(RORDATA(162.02,IENS,1.5,"I")) ;fee program
  1.  .. ;go to 'service provided' level and get requested data
  1.  .. S RORSVC=0 F  S RORSVC=$O(^FBAAC(RORDFN,1,RORVENDOR,1,RORITDT,1,RORSVC)) Q:'RORSVC  D
  1.  ... N IENSVC S IENSVC=RORSVC_","_RORITDT_","_RORVENDOR_","_RORDFN_","
  1.  ... K RORDATA,RORERR D GETS^DIQ(162.03,IENSVC,".01;5;16;28;30","IE","RORDATA","RORERR")
  1.  ... S FINALDT=$G(RORDATA(162.03,IENSVC,5,"I")) ;date finalized
  1.  ... Q:(($G(FINALDT)<RORSTDT)!($G(FINALDT)>(RORENDT)))  ;quit if outside date range
  1.  ... S ROROP("FINALDT")=FINALDT
  1.  ... S ROROP("SVC")=$G(RORDATA(162.03,IENSVC,.01,"E")) ;service provided
  1.  ... S ROROP("POV")=$G(RORDATA(162.03,IENSVC,16,"E")) ;purpose of visit
  1.  ... S ROROP("PDIAG")=$G(RORDATA(162.03,IENSVC,28,"E")) ;primary diagnosis
  1.  ... S ROROP("ICDVERSION")=$$ICDVER(80,$G(RORDATA(162.03,IENSVC,28,"I"))) ;ICD version
  1.  ... S ROROP("POS")=$G(RORDATA(162.03,IENSVC,30,"E")) ;place of service
  1.  ... S ROROP("IEN")=RORDFN_"-"_RORVENDOR_"-"_RORITDT_"-"_RORSVC
  1.  ... D ZSV(.ROROP)
  1.  ;
  1.  ;
  1.  ;---GET DRUG DATA FROM FEE BASIS PHARMACY INVOICE FILE #162.1
  1.  ;Date Certified for Payment (RORDCP) is used to determine inclusion in HL7 message
  1.  N RORRX,RORDCP,RXIEN0,RXIEN1
  1.  S RORDCP=(RORSTDT-.01) F  S RORDCP=$O(^FBAA(162.1,"AA",RORDCP)) Q:'RORDCP  Q:(RORDCP>RORENDT)  D
  1.  . S RXIEN0=0
  1.  . F  S RXIEN0=$O(^FBAA(162.1,"AA",RORDCP,RORDFN,RXIEN0)) Q:'RXIEN0  D
  1.  .. S RXIEN1=0 F  S RXIEN1=$O(^FBAA(162.1,"AA",RORDCP,RORDFN,RXIEN0,RXIEN1)) Q:'RXIEN1  D
  1.  ... K RORRX ;clean out previous data
  1.  ... S RORRX("NUM")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,1) ;rx number
  1.  ... S RORRX("NAME")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,2) ;drug name
  1.  ... Q:($G(RORRX("NAME"))="")  ;drug name is required
  1.  ... S RORRX("FILLDT")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,3) ;date filled
  1.  ... S RORRX("GENIEN")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,10) ;generic drug IEN
  1.  ... I $G(RORRX("GENIEN")) D  ;get generic drug name
  1.  .... D DATA^PSS50(RORRX("GENIEN"),,,,,"RORDRUG")
  1.  .... S RORRX("GENERIC")=$G(^TMP($J,"RORDRUG",RORRX("GENIEN"),.01)) ;generic drug name
  1.  .... K ^TMP($J,"RORDRUG")
  1.  ... S RORRX("STRENGTH")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,12) ;drug strength
  1.  ... S RORRX("QUANTITY")=$P($G(^FBAA(162.1,RXIEN0,"RX",RXIEN1,0)),U,13) ;drug quantity
  1.  ... S RORRX("IEN1")=$G(RXIEN0) S RORRX("IEN2")=$G(RXIEN1)
  1.  ... D ZRX(.RORRX)
  1.  Q
  1.  ;
  1.  ;
  1.  ;***** ZIN SEGMENT BUILDER
  1.  ;
  1.  ;Input
  1.  ;  RORIP     Array with inpatient data
  1.  ;
  1. ZIN(RORIP) ;
  1.  ;--- Segment type
  1.  N RORSEG S RORSEG(0)="ZIN"
  1.  ;ZIN-1: Unique Key (IEN)
  1.  S RORSEG(1)=$G(RORIP("IEN"))
  1.  ;ZIN-2: Treatment 'from' date
  1.  I $G(RORIP("TRFROMDT")) S RORSEG(2)=$$FM2HL^RORHL7(RORIP("TRFROMDT"))
  1.  ;ZIN-3: Treatment 'to' date
  1.  I $G(RORIP("TRTODT")) S RORSEG(3)=$$FM2HL^RORHL7(RORIP("TRTODT"))
  1.  ;ZIN-4: Discharge Type code
  1.  S RORSEG(4)=$G(RORIP("DISTYPE"))
  1.  ;ZIN-5: Amount Billed
  1.  S RORSEG(5)=$G(RORIP("BILLED"))
  1.  ;ZIN-6: Amount Paid
  1.  S RORSEG(6)=$G(RORIP("PAID"))
  1.  ;ZIN-7: Date Finalized
  1.  I $G(RORIP("FINALDT")) S RORSEG(7)=$$FM2HL^RORHL7(RORIP("FINALDT"))
  1.  ;ZIN-8: Discharge DRG
  1.  S RORSEG(8)=$G(RORIP("DISDRG"))
  1.  ;ZIN-9: Date of Admission
  1.  I $G(RORIP("ADMDT")) S RORSEG(9)=$$FM2HL^RORHL7(RORIP("ADMDT"))
  1.  ;ZIN-10: Date of Discharge
  1.  I $G(RORIP("DISDT")) S RORSEG(10)=$$FM2HL^RORHL7(RORIP("DISDT"))
  1.  ;ZIN-11: Covered Days
  1.  S RORSEG(11)=$G(RORIP("COVDAYS"))
  1.  ;ZIN-12: ICD 1
  1.  S RORSEG(12)=$G(RORIP("ICD1"))
  1.  ;ZIN-13: ICD 2
  1.  S RORSEG(13)=$G(RORIP("ICD2"))
  1.  ;ZIN-14: ICD 3
  1.  S RORSEG(14)=$G(RORIP("ICD3"))
  1.  ;ZIN-15: ICD 4
  1.  S RORSEG(15)=$G(RORIP("ICD4"))
  1.  ;ZIN-16: ICD 5
  1.  S RORSEG(16)=$G(RORIP("ICD5"))
  1.  ;ZIN-17: Procedure 1
  1.  S RORSEG(17)=$G(RORIP("PROC1"))
  1.  ;ZIN-18: Procedure 2
  1.  S RORSEG(18)=$G(RORIP("PROC2"))
  1.  ;ZIN-19: Procedure 3
  1.  S RORSEG(19)=$G(RORIP("PROC3"))
  1.  ;ZIN-20: Procedure 4
  1.  S RORSEG(20)=$G(RORIP("PROC4"))
  1.  ;ZIN-21: Procedure 5
  1.  S RORSEG(21)=$G(RORIP("PROC5"))
  1.  ;ZIN-22: ICD Version
  1.  S RORSEG(22)=$G(RORIP("ICDVERSION"))
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q
  1.  ;
  1.  ;***** ZSV SEGMENT BUILDER
  1.  ;
  1.  ;Input
  1.  ;  ROROP     Array with outpatient data
  1.  ;
  1. ZSV(ROROP) ;
  1.  ;--- Segment type
  1.  N RORSEG S RORSEG(0)="ZSV"
  1.  ;ZSV-1: Unique key (IEN)
  1.  S RORSEG(1)=$G(ROROP("IEN"))
  1.  ;ZSV-2: Initial Treatment Date
  1.  I $G(ROROP("TRDT")) S RORSEG(2)=$$FM2HL^RORHL7(ROROP("TRDT"))
  1.  ;ZSV-3: Fee Program IEN
  1.  S RORSEG(3)=$G(ROROP("FEEPGM"))
  1.  ;ZSV-4: Service Provided
  1.  S RORSEG(4)=$G(ROROP("SVC"))
  1.  ;ZSV-5: Purpose of Visit
  1.  S RORSEG(5)=$G(ROROP("POV"))
  1.  ;ZSV-6: Primary Diagnosis
  1.  S RORSEG(6)=$G(ROROP("PDIAG"))
  1.  ;ZSV-7: Place of Service
  1.  S RORSEG(7)=$G(ROROP("POS"))
  1.  ;ZSV-8: ICD Version
  1.  S RORSEG(8)=$G(ROROP("ICDVERSION"))
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q
  1.  ;
  1.  ;***** ZRX SEGMENT BUILDER
  1.  ;
  1.  ;Input
  1.  ;  RORRX     Array with drug data
  1.  ;
  1. ZRX(RORRX) ;
  1.  ;--- Segment type
  1.  N RORSEG S RORSEG(0)="ZRX"
  1.  ;ZRX-1: Unique key (IEN)
  1.  S RORSEG(1)=$G(RORRX("IEN1"))_"-"_$G(RORRX("IEN2"))
  1.  ;ZRX-2: Rx Number
  1.  S RORSEG(2)=$G(RORRX("NUM"))
  1.  ;ZRX-3: Date Rx Filled
  1.  I $G(RORRX("FILLDT")) S RORSEG(3)=$$FM2HL^RORHL7(RORRX("FILLDT"))
  1.  ;ZRX-4: Drug Name
  1.  S RORSEG(4)=$G(RORRX("NAME"))
  1.  ;ZRX-5: Generic Drug Name
  1.  S RORSEG(5)=$G(RORRX("GENERIC"))
  1.  ;ZRX-6: Drug Strength
  1.  S RORSEG(6)=$G(RORRX("STRENGTH"))
  1.  ;ZRX-7: Drug Quantity
  1.  S RORSEG(7)=$G(RORRX("QUANTITY"))
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q
  1.  ;
  1.  ;***** ICD VERSION
  1.  ;
  1.  ;Input
  1.  ; RORICDFILE - 80 or 80.1
  1.  ; RORICDIEN  - ICD IEN
  1.  ;
  1. ICDVER(RORICDFILE,RORICDIEN) ;
  1.  N RORICDSYS
  1.  S RORICDSYS=$$CSI^ICDEX($G(RORICDFILE),$G(RORICDIEN))
  1.  I (RORICDSYS=1)!(RORICDSYS=2) Q "I9^ICD-9^99VA80_4"
  1.  I (RORICDSYS=30)!(RORICDSYS=31) Q "I10^ICD-10^99VA80_4"
  1.  Q ""