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

RORP014.m

Go to the documentation of this file. 
  1. RORP014 ;BP/ACS CCR POST-INIT PATCH 14 ;12/31/10
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #3556    GCPR^LA7QRY (controlled)
  1.  ;
  1.  ;******************************************************************************
  1.  ;Change name of MELD report to "Liver Score by Range" in the ROR REPORT
  1.  ;PARAMETERS file (#799.34)
  1.  ;******************************************************************************
  1.  ;find IEN of existing "MELD Score by Range" entry
  1.  N IEN,IENS,RORFDA,RORMSG S IEN=$O(^ROR(799.34,"B","MELD Score by Range",0))
  1.  I $G(IEN) S IENS=IEN_"," D
  1.  . S RORFDA(799.34,IENS,.01)="Liver Score by Range"
  1.  . K RORMSG D FILE^DIE(,"RORFDA","RORMSG")
  1.  K RORFDA,RORMSG
  1.  ;
  1.  ;******************************************************************************
  1.  ;Add new entries to the ROR XML ITEM file (#799.31).  These entries are needed
  1.  ;for the new APRI/FIB4 calculations in the Liver Score by Range report.
  1.  ;******************************************************************************
  1.  N RORXML,RORTAG,RORFDA,RORERR
  1.  ;--- add codes
  1.  F I=1:1:5 S RORTAG="XML"_I D
  1.  . S RORXML=$T(@RORTAG)
  1.  . S RORXML=$P(RORXML,";;",2)
  1.  . ;don't add if it's already in the global
  1.  . Q:$D(^ROR(799.31,"B",RORXML))
  1.  . S RORFDA(799.31,"+1,",.01)=RORXML
  1.  . D UPDATE^DIE(,"RORFDA",,"RORERR")
  1.  K RORFDA,RORERR
  1.  ;
  1.  ;******************************************************************************
  1.  ;Add "Purchased Care" to the ROR DATA AREA file (#799.33)
  1.  ;******************************************************************************
  1.  ;remove old entries if they exist
  1.  N DA,DIK
  1.  S DIK="^ROR(799.33,",DA=$O(^ROR(799.33,"B","Purchased Care",0)) I $G(DA)>0 D ^DIK
  1.  N RORDA F RORDA="Purchased Care" D
  1.  . Q:$D(^ROR(799.33,"B",RORDA))  ;don't add if already in global
  1.  . N RORFDA,RORERR,RORIEN
  1.  . S RORFDA(799.33,"+1,",.01)=RORDA
  1.  . S RORIEN(1)=20 ;IEN=20 for Purchased Care
  1.  . D UPDATE^DIE(,"RORFDA","RORIEN","RORERR")
  1.  . K RORFDA,RORERR,RORIEN
  1.  ;
  1.  ;******************************************************************************
  1.  ;Update the PURCHASED CARE backpull entry in the ROR HISTORICAL DATA 
  1.  ;EXTRACT file with END DATE and ACTIVATION DATE = current date.
  1.  ;******************************************************************************
  1.  N RORIEN S RORIEN=$O(^RORDATA(799.6,"B","PURCHASED CARE",0))
  1.  I $G(RORIEN) D
  1.  . N DIE,DA,DR
  1.  . S DIE="^RORDATA(799.6,",DA=RORIEN,DR=".04///"_DT_";.07///"_DT D ^DIE
  1.  ;
  1.  ;******************************************************************************
  1.  ;Add new entries to the ROR LIST ITEM file (#799.1) for the 2 new Liver reports
  1.  ;in the MELD group
  1.  ;******************************************************************************
  1.  N RORDATA,RORTAG,RORFDA,I,TEXT,TYPE,REGISTRY,CODE
  1.  F I=1:1:4  S RORTAG="LI"_I D
  1.  . S RORDATA=$P($T(@RORTAG),";;",2)
  1.  . S TEXT=$P(RORDATA,"^",1) ;TEXT to add
  1.  . S TYPE=$P(RORDATA,"^",2) ;TYPE to add
  1.  . S REGISTRY=$P(RORDATA,"^",3) ;REGISTRY to add
  1.  . S CODE=$P(RORDATA,"^",4) ;CODE to add
  1.  . ;don't add if it's already in the global
  1.  . Q:$D(^ROR(799.1,"KEY",TYPE,REGISTRY,CODE))
  1.  . S RORFDA(799.1,"+1,",.01)=TEXT
  1.  . S RORFDA(799.1,"+1,",.02)=TYPE
  1.  . S RORFDA(799.1,"+1,",.03)=REGISTRY
  1.  . S RORFDA(799.1,"+1,",.04)=CODE
  1.  . D UPDATE^DIE(,"RORFDA",,"RORERR")
  1.  K RORFDA,RORERR
  1.  ;
  1.  ;******************************************************************************
  1.  ;Add new LOINC codes to the VA HEPC lab search criteria in the
  1.  ;ROR LAB SEARCH file #798.9.  Don't add them if they already exist.  Do not
  1.  ;add the 'dash' or the number following it.
  1.  ;******************************************************************************
  1.  N I,HEPCIEN,RORDATA,RORLOINC,RORTAG K RORMSG
  1.  N HEPCNT S HEPCNT=0
  1.  S HEPCIEN=$O(^ROR(798.9,"B","VA HEPC",0)) ;HEPC top level IEN
  1.  ;--- add LOINC codes to the VA HEPC search criteria
  1.  F I=1:1:9  S RORTAG="HEP"_I D
  1.  . S RORLOINC=$P($P($T(@RORTAG),";;",2),"-",1)
  1.  . ;don't add if it's already in the global
  1.  . Q:($D(^ROR(798.9,HEPCIEN,1,"B",RORLOINC)))
  1.  . S RORDATA(1,798.92,"+2,"_HEPCIEN_",",.01)=$G(RORLOINC)
  1.  . S RORDATA(1,798.92,"+2,"_HEPCIEN_",",1)=0 ;indicator: ingore
  1.  . D UPDATE^DIE("","RORDATA(1)",,"RORMSG")
  1.  . S HEPCNT=HEPCNT+1
  1.  K RORDATA,RORMSG
  1.  ;
  1.  ;******************************************************************************
  1.  ;Check each pending patient in the HEPC registry to see if they have ever had a positve
  1.  ;HCV LOINC.  If they have, then confirm them into the registry immediately.
  1.  ;******************************************************************************
  1.  N IEN,DFN,PTID,START,END,RORFS,RORCS,H7CH,HEPCREG
  1.  S H7CH="|^~\&",RORFS="|",RORCS="^"
  1.  S HEPCREG=$O(^ROR(798.1,"B","VA HEPC",0)) Q:'HEPCREG  ;HEPC Registry IEN
  1.  S IEN=0 F  S IEN=$O(^RORDATA(798,IEN)) Q:'IEN  D
  1.  . Q:$P($G(^RORDATA(798,IEN,0)),U,2)'=HEPCREG  ;quit if not HEPC registry
  1.  . Q:$P($G(^RORDATA(798,IEN,0)),U,5)'=4  ;quit if not pending patient
  1.  . S DFN=$P($G(^RORDATA(798,IEN,0)),U,1) ;get patient DFN
  1.  . Q:'DFN
  1.  . S PTID=$$PTID^RORUTL02(DFN) ;get patient ID for call to GCPR^LA7QRY
  1.  . Q:+PTID'>0
  1.  . S START="2000101^CD" ;start date 1/1/1900
  1.  . S END=DT_".235959^CD"
  1.  . N RORLC,RORMSG,RORHCV
  1.  . S RORLC="CH,MI" ;search Chem and Micro sub-files in #63
  1.  . S RORLC(12)="11011-4^LN"
  1.  . S RORLC(13)="29609-5^LN"
  1.  . S RORLC(14)="34703-9^LN"
  1.  . S RORLC(15)="34704-7^LN"
  1.  . S RORLC(16)="10676-5^LN"
  1.  . S RORLC(17)="20416-4^LN"
  1.  . S RORLC(18)="20571-6^LN"
  1.  . S RORLC(19)="49758-6^LN"
  1.  . S RORLC(20)="50023-1^LN"
  1.  . S RORHCV=$NA(^TMP("RORHCV",$J)) K @RORHCV ;output to hold the HCV test results
  1.  . N RC S RC=$$GCPR^LA7QRY(PTID,START,END,.RORLC,"*",.RORMSG,RORHCV,H7CH)
  1.  . I $D(@RORHCV)'>1 Q
  1.  . N RORNODE,RORSEG,RORVAL,RORDONE,SEGTYPE
  1.  . S RORNODE=0,RORDONE=0
  1.  . ;loop through output and see if the test result value in OBX contains ">" in first character
  1.  . F  S RORNODE=$O(^TMP("RORHCV",$J,RORNODE)) Q:(($G(RORNODE)="")!(RORDONE))  D
  1.  .. S RORSEG=$G(^TMP("RORHCV",$J,RORNODE)) ;entire HL7 segment
  1.  .. S SEGTYPE=$P(RORSEG,RORFS,1) ;segment type (PID,OBR,OBX,etc.)
  1.  .. Q:SEGTYPE'="OBX"  ;we want OBX segments only
  1.  .. S RORVAL=$P(RORSEG,RORFS,6) ;test result value
  1.  .. S RORVAL=$TR(RORVAL,"""","") ;get rid of double quotes around values
  1.  .. N IENS I $E($G(RORVAL),1,1)=">" S IENS=IEN_"," D  ;if positive test result
  1.  ... S RORFDA(798,IENS,3)=0 ;set status = confirmed
  1.  ... S RORFDA(798,IENS,12)="" ;set pending comment field to null
  1.  ... K RORMSG D FILE^DIE(,"RORFDA","RORMSG") ;update
  1.  ... S RORDONE=1
  1.  ;
  1.  D CLEAN^DILF
  1.  Q
  1.  ;******************************************************************************
  1.  ;New HEPC LOINC codes
  1.  ;******************************************************************************
  1. HEP1 ;;11011-4
  1. HEP2 ;;29609-5
  1. HEP3 ;;34703-9
  1. HEP4 ;;34704-7
  1. HEP5 ;;10676-5
  1. HEP6 ;;20416-4
  1. HEP7 ;;20571-6
  1. HEP8 ;;49758-6
  1. HEP9 ;;50023-1
  1.  ;
  1.  ;
  1.  ;******************************************************************************
  1.  ;new XML tags to be added to ROR XML ITEM file (#799.31)
  1.  ;******************************************************************************
  1. XML1 ;;LOINC_CODES
  1. XML2 ;;FIRSTDIAG
  1. XML3 ;;APRI
  1. XML4 ;;FIB4
  1. XML5 ;;ULNAST
  1.  ;
  1.  ;******************************************************************************
  1.  ; Data to be added to ROR LIST ITEM file (#799.1)
  1.  ; TEXT^TYPE^REGIEN^CODE
  1.  ;******************************************************************************
  1. LI1 ;;APRI^6^1^3
  1. LI2 ;;FIB-4^6^1^4
  1. LI3 ;;APRI^6^2^3
  1. LI4 ;;FIB-4^6^2^4