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

RORX013C.m

Go to the documentation of this file. 
  1. RORX013C ;HCIOFO/SG - DIAGNOSIS CODES (STORE) ;10/27/05 11:11am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**19,21,31,34,39**;Feb 17, 2006;Build 4
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #5747         $$ICDDX^ICDEX, $$CSI^ICDEX (controlled)
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ; --- ROUTINE MODIFICATION LOG ---
  1.  ; 
  1.  ;PKG/PATCH   DATE       DEVELOPER   MODIFICATION
  1.  ;----------- ---------- ----------- ----------------------------------------
  1.  ;ROR*1.5*19  FEB 2012   J SCOTT     Support for ICD-10 Coding System.
  1.  ;ROR*1.5*21  SEP 2013   T KOPP      Add ICN column if Additional Identifier
  1.  ;                                    requested.
  1.  ;ROR*1.5*31   MAY 2017  M FERRARESE  Adding PACT ,PCP,and AGE/DOB as additional
  1.  ;                                    identifiers.
  1.  ;ROR*1.5*34   SEP 2018  F TRAXLER   Adding FUT_APPT and FUT_CLIN
  1.  ;ROR*1.5*39   JUL 2021    M FERRARESE  Setting SSN and LAST4 to zeros
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** STORES THE ICD CODE TABLE
  1.  ;
  1.  ; PTAG          IEN of the parent element
  1.  ;
  1.  ; NODE          Closed root of the node of the temporary global
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. CODES(PTAG,NODE) ;
  1.  N ICDIEN,ITEM,TABLE,TMP,RORICDSYS,RORICDCODE
  1.  S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ICDLST",,PTAG)
  1.  Q:TABLE<0 TABLE
  1.  D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","ICDLST")
  1.  S ICDIEN=0
  1.  F  S ICDIEN=$O(@NODE@("ICD",ICDIEN))  Q:ICDIEN'>0  D
  1.  . S RORICDSYS=+$$CSI^ICDEX(80,ICDIEN)
  1.  . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ICD",,TABLE)
  1.  . S TMP=@NODE@("ICD",ICDIEN)
  1.  . S RORICDCODE="("_$S(RORICDSYS=1:"ICD-9",RORICDSYS=30:"ICD-10",1:"UNKN")_") "_$P(TMP,U,1)
  1.  . D ADDVAL^RORTSK11(RORTSK,"CODE",RORICDCODE,ITEM,2)
  1.  . D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,2),ITEM,2)
  1.  . S TMP=$G(@NODE@("ICD",ICDIEN,"P"))
  1.  . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
  1.  . S TMP=$G(@NODE@("ICD",ICDIEN,"C"))
  1.  . D ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
  1.  Q 0
  1.  ;
  1.  ;***** STORES THE PATIENT TABLE
  1.  ;
  1.  ; PTAG          IEN of the parent element
  1.  ;
  1.  ; NODE          Closed root of the node of the temporary global
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. PATIENTS(PTAG,NODE) ;
  1.  N DATE,ICD,ICDIEN,ITEM,PATIEN,PTICDL,SOURCE,TABLE,TMP,RORICDSYS,RORICDCODE,AGETYPE
  1.  S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
  1.  Q:TABLE<0 TABLE
  1.  D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
  1.  S PATIEN=0
  1.  S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
  1.  F  S PATIEN=$O(@NODE@("PAT",PATIEN))  Q:PATIEN'>0  D
  1.  . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
  1.  . S TMP=@NODE@("PAT",PATIEN)
  1.  . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(TMP,U,2),ITEM,2)
  1.  . S $P(TMP,U,1)="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U,1),ITEM,2)
  1.  . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(TMP,U,7),ITEM,1)
  1.  . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(TMP,U,3),ITEM,1)
  1.  . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(TMP,U,4),ITEM,1)
  1.  . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(TMP,U,5),ITEM,1)
  1.  . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(TMP,U,6),ITEM,1)
  1.  . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
  1.  . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",$P(TMP,U,8),ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",$P(TMP,U,9),ITEM,1)
  1.  . S PTICDL=$$ADDVAL^RORTSK11(RORTSK,"PTICDL",,ITEM)
  1.  . S ICDIEN=0
  1.  . F  S ICDIEN=$O(@NODE@("PAT",PATIEN,ICDIEN))  Q:ICDIEN'>0  D
  1.  . . S RORICDSYS=+$$CSI^ICDEX(80,ICDIEN)
  1.  . . S ICD=$$ADDVAL^RORTSK11(RORTSK,"ICD",,PTICDL)
  1.  . . S TMP=$G(@NODE@("PAT",PATIEN,ICDIEN))
  1.  . . S DATE=$P(TMP,U),SOURCE=$P(TMP,U,2)
  1.  . . S TMP=$$ICDDX^ICDEX(ICDIEN,DATE,,"I")
  1.  . . S:TMP<0 TMP=""
  1.  . . S RORICDCODE="("_$S(RORICDSYS=1:"ICD-9",RORICDSYS=30:"ICD-10",1:"UNKN")_") "_$P(TMP,U,2)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"CODE",RORICDCODE,ICD,2)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,4),ICD,2)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ICD,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SOURCE,ICD,2)
  1.  Q 0
  1.  ;
  1.  ;***** STORES THE REPORT DATA
  1.  ;
  1.  ; REPORT        IEN of the REPORT element
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. STORE(REPORT) ;
  1.  N ECNT,ICDIEN,PATIEN,RC,SECTION,TMP
  1.  S (ECNT,RC)=0
  1.  ;--- Diagnosis codes
  1.  S RC=$$CODES(REPORT,RORTMP)
  1.  I RC  Q:RC<0 RC  S ECNT=ECNT+RC
  1.  S RC=$$LOOP^RORTSK01(.4)  Q:RC<0 RC
  1.  ;--- Patients
  1.  S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
  1.  I TMP  D  I RC  Q:RC<0 RC  S ECNT=ECNT+RC
  1.  . S RC=$$PATIENTS(REPORT,RORTMP)
  1.  S RC=$$LOOP^RORTSK01(.99)  Q:RC<0 RC
  1.  ;--- Totals
  1.  S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
  1.  Q:SECTION<0 SECTION
  1.  S TMP=$G(@RORTMP@("ICD"))
  1.  D ADDVAL^RORTSK11(RORTSK,"NC",+$P(TMP,U,1),SECTION)
  1.  D ADDVAL^RORTSK11(RORTSK,"NDC",+$P(TMP,U,2),SECTION)
  1.  S TMP=$G(@RORTMP@("PAT"))
  1.  D ADDVAL^RORTSK11(RORTSK,"NP",+TMP,SECTION)
  1.  ;---
  1.  Q ECNT