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)