RORX013C ;HCIOFO/SG - DIAGNOSIS CODES (STORE) ;10/27/05 11:11am
;;1.5;CLINICAL CASE REGISTRIES;**19,21,31,34,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #5747 $$ICDDX^ICDEX, $$CSI^ICDEX (controlled)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
; requested.
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
; identifiers.
;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;******************************************************************************
;
Q
;
;***** STORES THE ICD CODE TABLE
;
; PTAG IEN of the parent element
;
; NODE Closed root of the node of the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
CODES(PTAG,NODE) ;
N ICDIEN,ITEM,TABLE,TMP,RORICDSYS,RORICDCODE
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ICDLST",,PTAG)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","ICDLST")
S ICDIEN=0
F S ICDIEN=$O(@NODE@("ICD",ICDIEN)) Q:ICDIEN'>0 D
. S RORICDSYS=+$$CSI^ICDEX(80,ICDIEN)
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ICD",,TABLE)
. S TMP=@NODE@("ICD",ICDIEN)
. S RORICDCODE="("_$S(RORICDSYS=1:"ICD-9",RORICDSYS=30:"ICD-10",1:"UNKN")_") "_$P(TMP,U,1)
. D ADDVAL^RORTSK11(RORTSK,"CODE",RORICDCODE,ITEM,2)
. D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,2),ITEM,2)
. S TMP=$G(@NODE@("ICD",ICDIEN,"P"))
. D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
. S TMP=$G(@NODE@("ICD",ICDIEN,"C"))
. D ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
Q 0
;
;***** STORES THE PATIENT TABLE
;
; PTAG IEN of the parent element
;
; NODE Closed root of the node of the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
PATIENTS(PTAG,NODE) ;
N DATE,ICD,ICDIEN,ITEM,PATIEN,PTICDL,SOURCE,TABLE,TMP,RORICDSYS,RORICDCODE,AGETYPE
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
S PATIEN=0
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
F S PATIEN=$O(@NODE@("PAT",PATIEN)) Q:PATIEN'>0 D
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
. S TMP=@NODE@("PAT",PATIEN)
. D ADDVAL^RORTSK11(RORTSK,"NAME",$P(TMP,U,2),ITEM,2)
. S $P(TMP,U,1)="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U,1),ITEM,2)
. I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(TMP,U,7),ITEM,1)
. D ADDVAL^RORTSK11(RORTSK,"DOD",$P(TMP,U,3),ITEM,1)
. I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(TMP,U,4),ITEM,1)
. I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(TMP,U,5),ITEM,1)
. I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(TMP,U,6),ITEM,1)
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",$P(TMP,U,8),ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",$P(TMP,U,9),ITEM,1)
. S PTICDL=$$ADDVAL^RORTSK11(RORTSK,"PTICDL",,ITEM)
. S ICDIEN=0
. F S ICDIEN=$O(@NODE@("PAT",PATIEN,ICDIEN)) Q:ICDIEN'>0 D
. . S RORICDSYS=+$$CSI^ICDEX(80,ICDIEN)
. . S ICD=$$ADDVAL^RORTSK11(RORTSK,"ICD",,PTICDL)
. . S TMP=$G(@NODE@("PAT",PATIEN,ICDIEN))
. . S DATE=$P(TMP,U),SOURCE=$P(TMP,U,2)
. . S TMP=$$ICDDX^ICDEX(ICDIEN,DATE,,"I")
. . S:TMP<0 TMP=""
. . S RORICDCODE="("_$S(RORICDSYS=1:"ICD-9",RORICDSYS=30:"ICD-10",1:"UNKN")_") "_$P(TMP,U,2)
. . D ADDVAL^RORTSK11(RORTSK,"CODE",RORICDCODE,ICD,2)
. . D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,4),ICD,2)
. . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ICD,1)
. . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SOURCE,ICD,2)
Q 0
;
;***** STORES THE REPORT DATA
;
; REPORT IEN of the REPORT element
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
STORE(REPORT) ;
N ECNT,ICDIEN,PATIEN,RC,SECTION,TMP
S (ECNT,RC)=0
;--- Diagnosis codes
S RC=$$CODES(REPORT,RORTMP)
I RC Q:RC<0 RC S ECNT=ECNT+RC
S RC=$$LOOP^RORTSK01(.4) Q:RC<0 RC
;--- Patients
S TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
I TMP D I RC Q:RC<0 RC S ECNT=ECNT+RC
. S RC=$$PATIENTS(REPORT,RORTMP)
S RC=$$LOOP^RORTSK01(.99) Q:RC<0 RC
;--- Totals
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
Q:SECTION<0 SECTION
S TMP=$G(@RORTMP@("ICD"))
D ADDVAL^RORTSK11(RORTSK,"NC",+$P(TMP,U,1),SECTION)
D ADDVAL^RORTSK11(RORTSK,"NDC",+$P(TMP,U,2),SECTION)
S TMP=$G(@RORTMP@("PAT"))
D ADDVAL^RORTSK11(RORTSK,"NP",+TMP,SECTION)
;---
Q ECNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX013C 5255 printed Sep 23, 2025@19:20:39 Page 2
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
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #5747 $$ICDDX^ICDEX, $$CSI^ICDEX (controlled)
+6 ;
+7 ;******************************************************************************
+8 ;******************************************************************************
+9 ; --- ROUTINE MODIFICATION LOG ---
+10 ;
+11 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+12 ;----------- ---------- ----------- ----------------------------------------
+13 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
+14 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+15 ; requested.
+16 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
+17 ; identifiers.
+18 ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN
+19 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+20 ;******************************************************************************
+21 ;******************************************************************************
+22 ;
+23 QUIT
+24 ;
+25 ;***** STORES THE ICD CODE TABLE
+26 ;
+27 ; PTAG IEN of the parent element
+28 ;
+29 ; NODE Closed root of the node of the temporary global
+30 ;
+31 ; Return Values:
+32 ; <0 Error code
+33 ; 0 Ok
+34 ; >0 Number of non-fatal errors
+35 ;
CODES(PTAG,NODE) ;
+1 NEW ICDIEN,ITEM,TABLE,TMP,RORICDSYS,RORICDCODE
+2 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"ICDLST",,PTAG)
+3 if TABLE<0
QUIT TABLE
+4 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","ICDLST")
+5 SET ICDIEN=0
+6 FOR
SET ICDIEN=$ORDER(@NODE@("ICD",ICDIEN))
if ICDIEN'>0
QUIT
Begin DoDot:1
+7 SET RORICDSYS=+$$CSI^ICDEX(80,ICDIEN)
+8 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"ICD",,TABLE)
+9 SET TMP=@NODE@("ICD",ICDIEN)
+10 SET RORICDCODE="("_$SELECT(RORICDSYS=1:"ICD-9",RORICDSYS=30:"ICD-10",1:"UNKN")_") "_$PIECE(TMP,U,1)
+11 DO ADDVAL^RORTSK11(RORTSK,"CODE",RORICDCODE,ITEM,2)
+12 DO ADDVAL^RORTSK11(RORTSK,"DIAG",$PIECE(TMP,U,2),ITEM,2)
+13 SET TMP=$GET(@NODE@("ICD",ICDIEN,"P"))
+14 DO ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
+15 SET TMP=$GET(@NODE@("ICD",ICDIEN,"C"))
+16 DO ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
End DoDot:1
+17 QUIT 0
+18 ;
+19 ;***** STORES THE PATIENT TABLE
+20 ;
+21 ; PTAG IEN of the parent element
+22 ;
+23 ; NODE Closed root of the node of the temporary global
+24 ;
+25 ; Return Values:
+26 ; <0 Error code
+27 ; 0 Ok
+28 ; >0 Number of non-fatal errors
+29 ;
PATIENTS(PTAG,NODE) ;
+1 NEW DATE,ICD,ICDIEN,ITEM,PATIEN,PTICDL,SOURCE,TABLE,TMP,RORICDSYS,RORICDCODE,AGETYPE
+2 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
+3 if TABLE<0
QUIT TABLE
+4 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
+5 SET PATIEN=0
+6 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+7 FOR
SET PATIEN=$ORDER(@NODE@("PAT",PATIEN))
if PATIEN'>0
QUIT
Begin DoDot:1
+8 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
+9 SET TMP=@NODE@("PAT",PATIEN)
+10 DO ADDVAL^RORTSK11(RORTSK,"NAME",$PIECE(TMP,U,2),ITEM,2)
+11 SET $PIECE(TMP,U,1)="0000"
DO ADDVAL^RORTSK11(RORTSK,"LAST4",$PIECE(TMP,U,1),ITEM,2)
+12 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(TMP,U,7),ITEM,1)
+13 DO ADDVAL^RORTSK11(RORTSK,"DOD",$PIECE(TMP,U,3),ITEM,1)
+14 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(TMP,U,4),ITEM,1)
+15 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(TMP,U,5),ITEM,1)
+16 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(TMP,U,6),ITEM,1)
+17 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:2
+18 DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",$PIECE(TMP,U,8),ITEM,1)
+19 DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",$PIECE(TMP,U,9),ITEM,1)
End DoDot:2
+20 SET PTICDL=$$ADDVAL^RORTSK11(RORTSK,"PTICDL",,ITEM)
+21 SET ICDIEN=0
+22 FOR
SET ICDIEN=$ORDER(@NODE@("PAT",PATIEN,ICDIEN))
if ICDIEN'>0
QUIT
Begin DoDot:2
+23 SET RORICDSYS=+$$CSI^ICDEX(80,ICDIEN)
+24 SET ICD=$$ADDVAL^RORTSK11(RORTSK,"ICD",,PTICDL)
+25 SET TMP=$GET(@NODE@("PAT",PATIEN,ICDIEN))
+26 SET DATE=$PIECE(TMP,U)
SET SOURCE=$PIECE(TMP,U,2)
+27 SET TMP=$$ICDDX^ICDEX(ICDIEN,DATE,,"I")
+28 if TMP<0
SET TMP=""
+29 SET RORICDCODE="("_$SELECT(RORICDSYS=1:"ICD-9",RORICDSYS=30:"ICD-10",1:"UNKN")_") "_$PIECE(TMP,U,2)
+30 DO ADDVAL^RORTSK11(RORTSK,"CODE",RORICDCODE,ICD,2)
+31 DO ADDVAL^RORTSK11(RORTSK,"DIAG",$PIECE(TMP,U,4),ICD,2)
+32 DO ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ICD,1)
+33 DO ADDVAL^RORTSK11(RORTSK,"SOURCE",SOURCE,ICD,2)
End DoDot:2
End DoDot:1
+34 QUIT 0
+35 ;
+36 ;***** STORES THE REPORT DATA
+37 ;
+38 ; REPORT IEN of the REPORT element
+39 ;
+40 ; Return Values:
+41 ; <0 Error code
+42 ; 0 Ok
+43 ; >0 Number of non-fatal errors
+44 ;
STORE(REPORT) ;
+1 NEW ECNT,ICDIEN,PATIEN,RC,SECTION,TMP
+2 SET (ECNT,RC)=0
+3 ;--- Diagnosis codes
+4 SET RC=$$CODES(REPORT,RORTMP)
+5 IF RC
if RC<0
QUIT RC
SET ECNT=ECNT+RC
+6 SET RC=$$LOOP^RORTSK01(.4)
if RC<0
QUIT RC
+7 ;--- Patients
+8 SET TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
+9 IF TMP
Begin DoDot:1
+10 SET RC=$$PATIENTS(REPORT,RORTMP)
End DoDot:1
IF RC
if RC<0
QUIT RC
SET ECNT=ECNT+RC
+11 SET RC=$$LOOP^RORTSK01(.99)
if RC<0
QUIT RC
+12 ;--- Totals
+13 SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
+14 if SECTION<0
QUIT SECTION
+15 SET TMP=$GET(@RORTMP@("ICD"))
+16 DO ADDVAL^RORTSK11(RORTSK,"NC",+$PIECE(TMP,U,1),SECTION)
+17 DO ADDVAL^RORTSK11(RORTSK,"NDC",+$PIECE(TMP,U,2),SECTION)
+18 SET TMP=$GET(@RORTMP@("PAT"))
+19 DO ADDVAL^RORTSK11(RORTSK,"NP",+TMP,SECTION)
+20 ;---
+21 QUIT ECNT
