133 lines
4.3 KiB
Mathematica
133 lines
4.3 KiB
Mathematica
RORX015C ;HCIOFO/SG - OUTPATIENT PROCEDURES (STORE) ; 6/27/06 10:54am
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #1995 $$CPT^ICPTCOD (supported)
|
|
; #3990 $$ICDOP^ICDCODE (supported)
|
|
;
|
|
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
|
|
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)
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"PROCODE",$P(TMP,U,1),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,IEN,ITEM,LAST4,PTIEN,PROCLST,PTCPTL,PTLST,PTNAME,SRC,TMP
|
|
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
|
|
F S PTIEN=$O(@NODE@("PAT",PTIEN)) Q:PTIEN'>0 D
|
|
. S TMP=@NODE@("PAT",PTIEN)
|
|
. S LAST4=$P(TMP,U),PTNAME=$P(TMP,U,2),DOD=$P(TMP,U,3)
|
|
. ;--- 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)
|
|
. . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,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)
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,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 TMP=$$ICDOP^ICDCODE(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,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
|