211 lines
6.4 KiB
Mathematica
211 lines
6.4 KiB
Mathematica
RORX003A ;HCIOFO/SG - GENERAL UTILIZATION AND DEMOGRAPHICS ; 11/14/06 8:50am
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #10061 2^VADPT (supported)
|
|
;
|
|
Q
|
|
;
|
|
;***** INCREMENTS SUMMARY COUNTER
|
|
INCSUM(SUMMARY,VAL) ;
|
|
S:$G(VAL)="" VAL="NO DATA"
|
|
S RORSUM(SUMMARY,VAL)=$G(RORSUM(SUMMARY,VAL))+1
|
|
Q
|
|
;
|
|
;***** ADDS THE PATIENT DATA TO THE REPORT
|
|
;
|
|
; IENS IENS of the patient's record in the registry
|
|
; PARTAG Reference (IEN) to the parent tag
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Skip the patient
|
|
;
|
|
PATIENT(IENS,PARTAG) ;
|
|
N DFN,IEN,NAME,RC,RORBUF,RORMSG,TMP,UTIL,VA,VADM,VAERR,VAHOW,VAPTYP,VAROOT
|
|
S RC=0
|
|
;
|
|
;--- Get the data from the ROR REGISTRY RECORD file
|
|
I $G(RORFL798)'="" D Q:RC<0 RC
|
|
. D GETS^DIQ(798,IENS,RORFL798,"I","RORBUF","RORMSG")
|
|
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798,IENS)
|
|
S DFN=$G(RORBUF(798,IENS,.01,"I"))
|
|
;
|
|
;--- Skip a patient without utilization
|
|
S UTIL=$$UTIL^RORXU003(RORSDT,ROREDT,DFN,.RORUTIL)
|
|
Q:'UTIL 1
|
|
;
|
|
;--- Get the data from the ROR HIV STUDY file
|
|
I $G(RORFLICR)'="" D Q:RC<0 RC
|
|
. D GETS^DIQ(799.4,IENS,RORFLICR,"I","RORBUF","RORMSG")
|
|
. I $G(DIERR),'$D(RORMSG("DIERR","E",601)) D Q
|
|
. . S RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
|
|
;
|
|
;--- Load the demographic data
|
|
D 2^VADPT
|
|
;
|
|
;--- The <PATIENT> tag
|
|
S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
|
|
Q:PTAG<0 PTAG S RORSUM=$G(RORSUM)+1
|
|
;--- Patient Name
|
|
D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
|
|
;--- SSN or LAST4
|
|
I $$OPTCOL^RORXU006("SSN") D
|
|
. D ADDVAL^RORTSK11(RORTSK,"SSN",$P(VADM(2),U),PTAG,2)
|
|
E D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
|
|
;
|
|
;--- Date of Birth
|
|
D:$$OPTCOL^RORXU006("DOB")
|
|
. S TMP=$$DATE^RORXU002(VADM(3)\1)
|
|
. D ADDVAL^RORTSK11(RORTSK,"DOB",TMP,PTAG,1)
|
|
. S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
|
|
. D INCSUM("DOB",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
|
|
;
|
|
;--- Age
|
|
D:$$OPTCOL^RORXU006("AGE")
|
|
. S TMP=+$G(VADM(6)) ; Date of Death
|
|
. S TMP=$S(TMP'>0:RORAGEDT,TMP<RORAGEDT:TMP,1:RORAGEDT)
|
|
. S TMP=$$FMDIFF^XLFDT(TMP,+VADM(3))\365
|
|
. D ADDVAL^RORTSK11(RORTSK,"AGE",$S(TMP>0:TMP,1:""),PTAG,1)
|
|
. Q:TMP'>0
|
|
. S RORSUM("AGE")=$G(RORSUM("AGE"))+1
|
|
. S RORSUM("AGE","Average")=$G(RORSUM("AGE","Average"))+TMP
|
|
. D INCSUM("AGE",TMP-(TMP#10))
|
|
;
|
|
;--- Sex
|
|
D:$$OPTCOL^RORXU006("SEX")
|
|
. S TMP=$P(VADM(5),U,2)
|
|
. D ADDVAL^RORTSK11(RORTSK,"SEX",TMP,PTAG,1)
|
|
. D INCSUM("SEX",TMP)
|
|
;
|
|
;--- Race
|
|
D:$$OPTCOL^RORXU006("RACE")
|
|
. N I,SUMVAL,TABLE
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"RACES",,PTAG)
|
|
. I $G(VADM(12))>0 S I="" D
|
|
. . F S I=$O(VADM(12,I)) Q:I="" D
|
|
. . . S SUMVAL=$P(VADM(12,I),U,2)
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"RACE",SUMVAL,TABLE)
|
|
. . S:VADM(12)>1 SUMVAL="MULTIPLE VALUES"
|
|
. E D ADDVAL^RORTSK11(RORTSK,"RACE",,TABLE)
|
|
. D INCSUM("RACE",$G(SUMVAL))
|
|
;
|
|
;--- Ethnicity
|
|
D:$$OPTCOL^RORXU006("RACE")
|
|
. N I,SUMVAL,TABLE
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ETHNS",,PTAG)
|
|
. I $G(VADM(11))>0 S I="" D
|
|
. . F S I=$O(VADM(11,I)) Q:I="" D
|
|
. . . S SUMVAL=$P(VADM(11,I),U,2)
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"ETHN",SUMVAL,TABLE)
|
|
. . S:VADM(11)>1 SUMVAL="MULTIPLE VALUES"
|
|
. E D ADDVAL^RORTSK11(RORTSK,"ETHN",,TABLE)
|
|
. D INCSUM("ETHN",$G(SUMVAL))
|
|
;
|
|
;--- Risk factors
|
|
D:$$OPTCOL^RORXU006("RISK")
|
|
. N I,RISKS
|
|
. S RISKS=$$RISKS^RORXU005(+IENS) S:RISKS<0 RISKS=""
|
|
. D ADDVAL^RORTSK11(RORTSK,"RISK",RISKS,PTAG)
|
|
. S RISKS=$TR(RISKS," ")
|
|
. F I=1:1 S TMP=$P(RISKS,",",I) Q:TMP'>0 D
|
|
. . S RORRISK(TMP)=$G(RORRISK(TMP))+1
|
|
;
|
|
;--- Date Selected
|
|
D:$$OPTCOL^RORXU006("SELDT")
|
|
. S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,3.2,"I"))\1)
|
|
. D ADDVAL^RORTSK11(RORTSK,"SELDT",TMP,PTAG,1)
|
|
. S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
|
|
. D INCSUM("SELDT",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
|
|
;
|
|
;--- Date Confirmed
|
|
D:$$OPTCOL^RORXU006("CONFDT")
|
|
. S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,2,"I"))\1)
|
|
. D ADDVAL^RORTSK11(RORTSK,"CONFDT",TMP,PTAG,1)
|
|
. S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
|
|
. D INCSUM("CONFDT",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
|
|
;
|
|
;--- Utilization
|
|
D:$$OPTCOL^RORXU006("UTIL")
|
|
. S TMP=$$UTLCODES($P(UTIL,U,2,999))
|
|
. D ADDVAL^RORTSK11(RORTSK,"UTIL",TMP,PTAG)
|
|
;
|
|
;--- Date of Death
|
|
D:$$OPTCOL^RORXU006("DOD")
|
|
. S TMP=$$DATE^RORXU002(VADM(6)\1)
|
|
. D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
|
|
. S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
|
|
. D INCSUM("DOD",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
|
|
Q 0
|
|
;
|
|
;***** GENERATES THE REPORT SUMMARY
|
|
;
|
|
; PARTAG Reference (IEN) to the parent tag
|
|
;
|
|
; PATIENTS Reference (IEN) to the PATIENTS tag
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
SUMMARY(PARTAG,PATIENTS) ;
|
|
N AGE,I,RC,RORBUF,SI,SUMMARY,TABLE,TAG,TMP
|
|
S SUMMARY=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PARTAG)
|
|
Q:SUMMARY<0 SUMMARY
|
|
;
|
|
;--- Risk factors
|
|
D:$D(RORRISK)>1
|
|
. K RORBUF D BLD^DIALOG(7980000.016,.RORRISK,,"RORBUF")
|
|
. D ADDTEXT^RORTSK11(RORTSK,"RISK_FACTORS",.RORBUF,SUMMARY)
|
|
;
|
|
;--- Simple summaries
|
|
F SI="RACE","ETHN","SEX" D:$D(RORSUM(SI))>1
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
|
|
. S I=""
|
|
. F S I=$O(RORSUM(SI,I)) Q:I="" D
|
|
. . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
|
|
. . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
|
|
;
|
|
;--- Date summaries
|
|
F SI="DOB","DOD","CONFDT","SELDT" D:$D(RORSUM(SI))>1
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
|
|
. D:$G(RORSUM(SI,0))>0
|
|
. . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,"Before "_RORDTE0,TABLE)
|
|
. . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,0))
|
|
. S I=0
|
|
. F S I=$O(RORSUM(SI,I)) Q:I="" D
|
|
. . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
|
|
. . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
|
|
;
|
|
;--- Age summary
|
|
I $G(RORSUM("AGE"))>0 D
|
|
. ;--- Average age
|
|
. S TMP=$G(RORSUM("AGE","Average"))/RORSUM("AGE")
|
|
. S RORSUM("AGE","Average")=$J(TMP,0,2)
|
|
. ;--- Median age
|
|
. S TMP=$$XREFNODE^RORTSK10(RORTSK,PATIENTS,"AGE")
|
|
. S:TMP'="" TMP=$$XREFMDNV^RORXU004(TMP,RORSUM("AGE"))
|
|
. S RORSUM("AGE","Median")=$S(TMP'="":$J(TMP,0,2),1:"")
|
|
. ;--- Output the table
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"AGE_SUMMARY",,SUMMARY)
|
|
. S I=""
|
|
. F S I=$O(RORSUM("AGE",I)) Q:I="" D
|
|
. . S TAG=$$ADDVAL^RORTSK11(RORTSK,"AGE",$S(+I=I:I_"+",1:I),TABLE)
|
|
. . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM("AGE",I))
|
|
;
|
|
;--- Utilization codes
|
|
D:$D(RORUCNT)>1
|
|
. K RORBUF D BLD^DIALOG(7980000.017,.RORUCNT,,"RORBUF")
|
|
. D ADDTEXT^RORTSK11(RORTSK,"UTIL_CODES",.RORBUF,SUMMARY)
|
|
;---
|
|
Q 0
|
|
;
|
|
;***** PROCESSES UTILIZATION CODES
|
|
UTLCODES(UCSRC) ;
|
|
N I,UCLST S UCLST=""
|
|
F I=1:1 S UC=$P(UCSRC,U,I) Q:UC="" D
|
|
. S UCLST=UCLST_", "_UC,RORUCNT(UC)=$G(RORUCNT(UC))+1
|
|
Q $P(UCLST,", ",2,999)
|