- 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 Mar 13, 2025@20:49:24 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
