RORX015C ;HCIOFO/SG - OUTPATIENT PROCEDURES (STORE) ;6/27/06 10:54am
 ;;1.5;CLINICAL CASE REGISTRIES;**1,19,21,31,34,39**;Feb 17, 2006;Build 4
 ;
 ; This routine uses the following IAs:
 ;
 ; #1995         $$CPT^ICPTCOD (supported)
 ; #5747         $$ICDOP^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      Added ICN as last report column if
 ;                                    additional identifier option selected
 ;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 PROCEDURE 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 IEN,ITEM,NAME,SRC,TABLE,TMP,RORPROCSYS,RORPROCCODE
 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PROCLST",,PTAG)
 Q:TABLE<0 TABLE
 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PROCLST")
 S NAME=""
 F  S NAME=$O(@NODE@("PROC","B",NAME))  Q:NAME=""  D
 . S SRC=""
 . F  S SRC=$O(@NODE@("PROC","B",NAME,SRC))  Q:SRC=""  D
 . . S IEN=0
 . . F  S IEN=$O(@NODE@("PROC","B",NAME,SRC,IEN))  Q:IEN'>0  D
 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,TABLE)
 . . . S TMP=@NODE@("PROC",SRC,IEN)
 . . . S RORPROCCODE=$P(TMP,U,1)
 . . . I SRC="I" D
 . . . . S RORPROCSYS=+$$CSI^ICDEX(80.1,IEN)
 . . . . S RORPROCCODE="("_$S(RORPROCSYS=2:"ICD-9",RORPROCSYS=31:"ICD-10",1:"UNKN")_") "_RORPROCCODE
 . . . D ADDVAL^RORTSK11(RORTSK,"PROCODE",RORPROCCODE,ITEM,2)
 . . . D ADDVAL^RORTSK11(RORTSK,"PROCNAME",$P(TMP,U,2),ITEM,2)
 . . . S TMP=$G(@NODE@("PROC",SRC,IEN,"P"))
 . . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
 . . . S TMP=$G(@NODE@("PROC",SRC,IEN,"C"))
 . . . D ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
 . . . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SRC,ITEM,1)
 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,DOD,ICN,IEN,ITEM,LAST4,PACT,PCP,PTIEN,PROCLST,PTCPTL,PTLST,PTNAME,SRC,TMP,RORPROCSYS,RORPROCCODE,RORAPPT,RORAPPTINFO,RORCLIN
 N AGE,AGETYPE
 S (PROCLST,PTLST)=-1
 ;--- Table for patients with procedures
 I RORPROC>0  D  Q:PROCLST<0 PROCLST
 . S PROCLST=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURES",,PTAG)
 . D ADDATTR^RORTSK11(RORTSK,PROCLST,"TABLE","PROCEDURES")
 . ;--- Force the privacy note
 . D ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTAG)
 ;--- Table for patients without procedures
 I RORPROC<0  D  Q:PTLST<0 PTLST
 . S PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
 . D ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
 ;---
 S PTIEN=0
 S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
 F  S PTIEN=$O(@NODE@("PAT",PTIEN))  Q:PTIEN'>0  D
 . S TMP=@NODE@("PAT",PTIEN)
 . S LAST4="0000",PTNAME=$P(TMP,U,2),DOD=$P(TMP,U,3),ICN=$P(TMP,U,4),PACT=$P(TMP,U,5),PCP=$P(TMP,U,6),AGE=$P(TMP,U,7),RORAPPT=$P(TMP,U,8),RORCLIN=$P(TMP,U,9)
 . ;--- Patient list
 . I RORPROC<0  D  Q
 . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,PTIEN)
 . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,2)
 . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
 . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
 . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
 . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
 . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
 . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
 . .I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
 . . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORAPPT,ITEM,1)
 . . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
 . ;--- Patients and procedures
 . F SRC="I","O"  D
 . . S IEN=0
 . . F  S IEN=$O(@NODE@("PAT",PTIEN,SRC,IEN))  Q:IEN'>0  D
 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,PROCLST,,PTIEN)
 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,2)
 . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
 . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
 . . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
 . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
 . . . I $$PARAM^RORTSK01("PATIENTS","PACT") S PACT="" S PACT=$$PACT^RORUTL02(PTIEN) D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
 . . . I $$PARAM^RORTSK01("PATIENTS","PCP") S PCP="" S PCP=$$PCP^RORUTL02(PTIEN) D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
 . . . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
 . . . . S RORAPPTINFO=$$FUTAPPT^RORUTL02(PTIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
 . . . . S RORAPPT=$P(RORAPPTINFO,U,1),RORCLIN=$P(RORAPPTINFO,U,2)
 . . . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORAPPT,ITEM,1)
 . . . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
 . . . S TMP=$G(@NODE@("PAT",PTIEN,SRC,IEN))
 . . . S DATE=$P(TMP,U)
 . . . I SRC="O"  D
 . . . . S TMP=$$CPT^ICPTCOD(IEN,DATE)  S:TMP<0 TMP=""
 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCODE",$P(TMP,U,2),ITEM,2)
 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCNAME",$P(TMP,U,3),ITEM,2)
 . . . E  D
 . . . . S RORPROCSYS=+$$CSI^ICDEX(80.1,IEN)
 . . . . S TMP=$$ICDOP^ICDEX(IEN,DATE,,"I")  S:TMP<0 TMP=""
 . . . . S RORPROCCODE="("_$S(RORPROCSYS=2:"ICD-9",RORPROCSYS=31:"ICD-10",1:"UNKN")_") "_$P(TMP,U,2)
 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCODE",RORPROCCODE,ITEM,2)
 . . . . D ADDVAL^RORTSK11(RORTSK,"PROCNAME",$P(TMP,U,5),ITEM,2)
 . . . D ADDVAL^RORTSK11(RORTSK,"DATE",$$DATE^RORXU002(DATE\1),ITEM,1)
 . . . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SRC,ITEM,1)
 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,RC,SECTION,TMP
 S (ECNT,RC)=0
 ;--- Procedure codes
 I RORPROC>0  D  Q:RC<0 RC
 . S RC=$$CODES(REPORT,RORTMP)
 . I RC  Q:RC<0  S ECNT=ECNT+RC
 . S RC=$$LOOP^RORTSK01(.3)
 ;--- 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@("PROC"))
 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[HRORX015C   7424     printed  Sep 23, 2025@19:20:44                                                                                                                                                                                                    Page 2
RORX015C  ;HCIOFO/SG - OUTPATIENT PROCEDURES (STORE) ;6/27/06 10:54am
 +1       ;;1.5;CLINICAL CASE REGISTRIES;**1,19,21,31,34,39**;Feb 17, 2006;Build 4
 +2       ;
 +3       ; This routine uses the following IAs:
 +4       ;
 +5       ; #1995         $$CPT^ICPTCOD (supported)
 +6       ; #5747         $$ICDOP^ICDEX, $$CSI^ICDEX (controlled)
 +7       ;
 +8       ;******************************************************************************
 +9       ;******************************************************************************
 +10      ; --- ROUTINE MODIFICATION LOG ---
 +11      ; 
 +12      ;PKG/PATCH   DATE       DEVELOPER   MODIFICATION
 +13      ;----------- ---------- ----------- ----------------------------------------
 +14      ;ROR*1.5*19  FEB 2012   J SCOTT     Support for ICD-10 Coding System.
 +15      ;ROR*1.5*21  SEP 2013   T KOPP      Added ICN as last report column if
 +16      ;                                    additional identifier option selected
 +17      ;ROR*1.5*31   MAY 2017  M FERRARESE  Adding PACT, PCP, and AGE/DOB as additional
 +18      ;                                    identifiers.
 +19      ;ROR*1.5*34   SEP 2018  F TRAXLER   Adding FUT_APPT and FUT_CLIN
 +20      ;ROR*1.5*39   JUL 2021    M FERRARESE  Setting SSN and LAST4 to zeros
 +21      ;******************************************************************************
 +22      ;******************************************************************************
 +23       QUIT 
 +24      ;
 +25      ;***** STORES THE PROCEDURE 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 IEN,ITEM,NAME,SRC,TABLE,TMP,RORPROCSYS,RORPROCCODE
 +2        SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"PROCLST",,PTAG)
 +3        if TABLE<0
               QUIT TABLE
 +4        DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PROCLST")
 +5        SET NAME=""
 +6        FOR 
               SET NAME=$ORDER(@NODE@("PROC","B",NAME))
               if NAME=""
                   QUIT 
               Begin DoDot:1
 +7                SET SRC=""
 +8                FOR 
                       SET SRC=$ORDER(@NODE@("PROC","B",NAME,SRC))
                       if SRC=""
                           QUIT 
                       Begin DoDot:2
 +9                        SET IEN=0
 +10                       FOR 
                               SET IEN=$ORDER(@NODE@("PROC","B",NAME,SRC,IEN))
                               if IEN'>0
                                   QUIT 
                               Begin DoDot:3
 +11                               SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,TABLE)
 +12                               SET TMP=@NODE@("PROC",SRC,IEN)
 +13                               SET RORPROCCODE=$PIECE(TMP,U,1)
 +14                               IF SRC="I"
                                       Begin DoDot:4
 +15                                       SET RORPROCSYS=+$$CSI^ICDEX(80.1,IEN)
 +16                                       SET RORPROCCODE="("_$SELECT(RORPROCSYS=2:"ICD-9",RORPROCSYS=31:"ICD-10",1:"UNKN")_") "_RORPROCCODE
                                       End DoDot:4
 +17                               DO ADDVAL^RORTSK11(RORTSK,"PROCODE",RORPROCCODE,ITEM,2)
 +18                               DO ADDVAL^RORTSK11(RORTSK,"PROCNAME",$PIECE(TMP,U,2),ITEM,2)
 +19                               SET TMP=$GET(@NODE@("PROC",SRC,IEN,"P"))
 +20                               DO ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
 +21                               SET TMP=$GET(@NODE@("PROC",SRC,IEN,"C"))
 +22                               DO ADDVAL^RORTSK11(RORTSK,"NC",TMP,ITEM,3)
 +23                               DO ADDVAL^RORTSK11(RORTSK,"SOURCE",SRC,ITEM,1)
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +24       QUIT 0
 +25      ;
 +26      ;***** STORES THE PATIENT TABLE
 +27      ;
 +28      ; PTAG          IEN of the parent element
 +29      ;
 +30      ; NODE          Closed root of the node of the temporary global
 +31      ;
 +32      ; Return Values:
 +33      ;       <0  Error code
 +34      ;        0  Ok
 +35      ;       >0  Number of non-fatal errors
 +36      ;
PATIENTS(PTAG,NODE) ;
 +1        NEW DATE,DOD,ICN,IEN,ITEM,LAST4,PACT,PCP,PTIEN,PROCLST,PTCPTL,PTLST,PTNAME,SRC,TMP,RORPROCSYS,RORPROCCODE,RORAPPT,RORAPPTINFO,RORCLIN
 +2        NEW AGE,AGETYPE
 +3        SET (PROCLST,PTLST)=-1
 +4       ;--- Table for patients with procedures
 +5        IF RORPROC>0
               Begin DoDot:1
 +6                SET PROCLST=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURES",,PTAG)
 +7                DO ADDATTR^RORTSK11(RORTSK,PROCLST,"TABLE","PROCEDURES")
 +8       ;--- Force the privacy note
 +9                DO ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTAG)
               End DoDot:1
               if PROCLST<0
                   QUIT PROCLST
 +10      ;--- Table for patients without procedures
 +11       IF RORPROC<0
               Begin DoDot:1
 +12               SET PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
 +13               DO ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
               End DoDot:1
               if PTLST<0
                   QUIT PTLST
 +14      ;---
 +15       SET PTIEN=0
 +16       SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
 +17       FOR 
               SET PTIEN=$ORDER(@NODE@("PAT",PTIEN))
               if PTIEN'>0
                   QUIT 
               Begin DoDot:1
 +18               SET TMP=@NODE@("PAT",PTIEN)
 +19               SET LAST4="0000"
                   SET PTNAME=$PIECE(TMP,U,2)
                   SET DOD=$PIECE(TMP,U,3)
                   SET ICN=$PIECE(TMP,U,4)
                   SET PACT=$PIECE(TMP,U,5)
                   SET PCP=$PIECE(TMP,U,6)
                   SET AGE=$PIECE(TMP,U,7)
                   SET RORAPPT=$PIECE(TMP,U,8)
                   SET RORCLIN=$PIECE(TMP,U,9)
 +20      ;--- Patient list
 +21               IF RORPROC<0
                       Begin DoDot:2
 +22                       SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,PTIEN)
 +23                       DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,2)
 +24                       DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
 +25                       IF AGETYPE'="ALL"
                               DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
 +26                       DO ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
 +27                       IF $$PARAM^RORTSK01("PATIENTS","ICN")
                               DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
 +28                       IF $$PARAM^RORTSK01("PATIENTS","PACT")
                               DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
 +29                       IF $$PARAM^RORTSK01("PATIENTS","PCP")
                               DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
 +30                       IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
                               Begin DoDot:3
 +31                               DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORAPPT,ITEM,1)
 +32                               DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
                               End DoDot:3
                       End DoDot:2
                       QUIT 
 +33      ;--- Patients and procedures
 +34               FOR SRC="I","O"
                       Begin DoDot:2
 +35                       SET IEN=0
 +36                       FOR 
                               SET IEN=$ORDER(@NODE@("PAT",PTIEN,SRC,IEN))
                               if IEN'>0
                                   QUIT 
                               Begin DoDot:3
 +37                               SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,PROCLST,,PTIEN)
 +38                               DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,2)
 +39                               DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
 +40                               IF AGETYPE'="ALL"
                                       DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
 +41                               DO ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
 +42                               IF $$PARAM^RORTSK01("PATIENTS","ICN")
                                       DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
 +43                               IF $$PARAM^RORTSK01("PATIENTS","PACT")
                                       SET PACT=""
                                       SET PACT=$$PACT^RORUTL02(PTIEN)
                                       DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
 +44                               IF $$PARAM^RORTSK01("PATIENTS","PCP")
                                       SET PCP=""
                                       SET PCP=$$PCP^RORUTL02(PTIEN)
                                       DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
 +45                               IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
                                       Begin DoDot:4
 +46                                       SET RORAPPTINFO=$$FUTAPPT^RORUTL02(PTIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
 +47                                       SET RORAPPT=$PIECE(RORAPPTINFO,U,1)
                                           SET RORCLIN=$PIECE(RORAPPTINFO,U,2)
 +48                                       DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORAPPT,ITEM,1)
 +49                                       DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
                                       End DoDot:4
 +50                               SET TMP=$GET(@NODE@("PAT",PTIEN,SRC,IEN))
 +51                               SET DATE=$PIECE(TMP,U)
 +52                               IF SRC="O"
                                       Begin DoDot:4
 +53                                       SET TMP=$$CPT^ICPTCOD(IEN,DATE)
                                           if TMP<0
                                               SET TMP=""
 +54                                       DO ADDVAL^RORTSK11(RORTSK,"PROCODE",$PIECE(TMP,U,2),ITEM,2)
 +55                                       DO ADDVAL^RORTSK11(RORTSK,"PROCNAME",$PIECE(TMP,U,3),ITEM,2)
                                       End DoDot:4
 +56                              IF '$TEST
                                       Begin DoDot:4
 +57                                       SET RORPROCSYS=+$$CSI^ICDEX(80.1,IEN)
 +58                                       SET TMP=$$ICDOP^ICDEX(IEN,DATE,,"I")
                                           if TMP<0
                                               SET TMP=""
 +59                                       SET RORPROCCODE="("_$SELECT(RORPROCSYS=2:"ICD-9",RORPROCSYS=31:"ICD-10",1:"UNKN")_") "_$PIECE(TMP,U,2)
 +60                                       DO ADDVAL^RORTSK11(RORTSK,"PROCODE",RORPROCCODE,ITEM,2)
 +61                                       DO ADDVAL^RORTSK11(RORTSK,"PROCNAME",$PIECE(TMP,U,5),ITEM,2)
                                       End DoDot:4
 +62                               DO ADDVAL^RORTSK11(RORTSK,"DATE",$$DATE^RORXU002(DATE\1),ITEM,1)
 +63                               DO ADDVAL^RORTSK11(RORTSK,"SOURCE",SRC,ITEM,1)
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +64       QUIT 0
 +65      ;
 +66      ;***** STORES THE REPORT DATA
 +67      ;
 +68      ; REPORT        IEN of the REPORT element
 +69      ;
 +70      ; Return Values:
 +71      ;       <0  Error code
 +72      ;        0  Ok
 +73      ;       >0  Number of non-fatal errors
 +74      ;
STORE(REPORT) ;
 +1        NEW ECNT,RC,SECTION,TMP
 +2        SET (ECNT,RC)=0
 +3       ;--- Procedure codes
 +4        IF RORPROC>0
               Begin DoDot:1
 +5                SET RC=$$CODES(REPORT,RORTMP)
 +6                IF RC
                       if RC<0
                           QUIT 
                       SET ECNT=ECNT+RC
 +7                SET RC=$$LOOP^RORTSK01(.3)
               End DoDot:1
               if RC<0
                   QUIT RC
 +8       ;--- Patients
 +9        SET TMP=$$PARAM^RORTSK01("OPTIONS","COMPLETE")
 +10       IF TMP
               Begin DoDot:1
 +11               SET RC=$$PATIENTS(REPORT,RORTMP)
               End DoDot:1
               IF RC
                   if RC<0
                       QUIT RC
                   SET ECNT=ECNT+RC
 +12       SET RC=$$LOOP^RORTSK01(.99)
           if RC<0
               QUIT RC
 +13      ;--- Totals
 +14       SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
 +15       if SECTION<0
               QUIT SECTION
 +16       SET TMP=$GET(@RORTMP@("PROC"))
 +17       DO ADDVAL^RORTSK11(RORTSK,"NC",+$PIECE(TMP,U,1),SECTION)
 +18       DO ADDVAL^RORTSK11(RORTSK,"NDC",+$PIECE(TMP,U,2),SECTION)
 +19       SET TMP=$GET(@RORTMP@("PAT"))
 +20       DO ADDVAL^RORTSK11(RORTSK,"NP",+TMP,SECTION)
 +21      ;---
 +22       QUIT ECNT