RORX013C ;HCIOFO/SG - DIAGNOSIS CODES (STORE) ; 10/27/05 11:11am
 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 ;
 ; This routine uses the following IAs:
 ;
 ; #3990         $$ICDDX^ICDCODE (supported)
 ;
 Q
 ;
 ;***** STORES THE ICD-9 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
 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ICD9LST",,PTAG)
 Q:TABLE<0 TABLE
 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","ICD9LST")
 S ICDIEN=0
 F  S ICDIEN=$O(@NODE@("ICD",ICDIEN))  Q:ICDIEN'>0  D
 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ICD9",,TABLE)
 . S TMP=@NODE@("ICD",ICDIEN)
 . D ADDVAL^RORTSK11(RORTSK,"CODE",$P(TMP,U,1),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,ICD9,ICDIEN,ITEM,PATIEN,PTICDL,SOURCE,TABLE,TMP
 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PTAG)
 Q:TABLE<0 TABLE
 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
 S PATIEN=0
 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)
 . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U,1),ITEM,2)
 . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(TMP,U,3),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 ICD9=$$ADDVAL^RORTSK11(RORTSK,"ICD9",,PTICDL)
 . . S TMP=$G(@NODE@("PAT",PATIEN,ICDIEN))
 . . S DATE=$P(TMP,U),SOURCE=$P(TMP,U,2)
 . . S TMP=$$ICDDX^ICDCODE(ICDIEN,DATE)
 . . S:TMP<0 TMP=""
 . . D ADDVAL^RORTSK11(RORTSK,"CODE",$P(TMP,U,2),ICD9,2)
 . . D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(TMP,U,4),ICD9,2)
 . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ICD9,1)
 . . D ADDVAL^RORTSK11(RORTSK,"SOURCE",SOURCE,ICD9,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