RORX003A ;HCIOFO/SG - GENERAL UTILIZATION AND DEMOGRAPHICS ;11/14/06 8:50am
;;1.5;CLINICAL CASE REGISTRIES;**1,21,30,31,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #10061 2^VADPT (supported)
;
Q
;
;** MODIFICATIONS **
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
; additional identifier option selected
;ROR*1.5*30 OCT 2016 M FERRARESE Changing the display for "Sex" to "Birth Sex"
;
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
;
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;**
;***** 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,PTAG,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
.S $P(VADM(2),U)="000000000" D ADDVAL^RORTSK11(RORTSK,"SSN",$P(VADM(2),U),PTAG,2)
E S VA("BID")="0000" 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))
;
;--- Birth Sex
D:$$OPTCOL^RORXU006("BIRTHSEX")
. S TMP=$P(VADM(5),U,2)
. D ADDVAL^RORTSK11(RORTSK,"BIRTHSEX",TMP,PTAG,1)
. D INCSUM("BIRTHSEX",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:""))
;
;--- ICN
I $$PARAM^RORTSK01("PATIENTS","ICN") D
. S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
. D ICNDATA^RORXU006(RORTSK,DFN,PTAG)
;--- PACT
I $$PARAM^RORTSK01("PATIENTS","PACT") D
. S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
. D PACTDATA^RORXU006(RORTSK,DFN,PTAG)
;
;--- PCP
I $$PARAM^RORTSK01("PATIENTS","PCP") D
. S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
. D PCPDATA^RORXU006(RORTSK,DFN,PTAG)
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","BIRTHSEX" 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,UC 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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX003A 7846 printed Apr 09, 2024@20:46:48 Page 2
RORX003A ;HCIOFO/SG - GENERAL UTILIZATION AND DEMOGRAPHICS ;11/14/06 8:50am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,21,30,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10061 2^VADPT (supported)
+6 ;
+7 QUIT
+8 ;
+9 ;** MODIFICATIONS **
+10 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+11 ; additional identifier option selected
+12 ;ROR*1.5*30 OCT 2016 M FERRARESE Changing the display for "Sex" to "Birth Sex"
+13 ;
+14 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
+15 ;
+16 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+17 ;**
+18 ;***** INCREMENTS SUMMARY COUNTER
INCSUM(SUMMARY,VAL) ;
+1 if $GET(VAL)=""
SET VAL="NO DATA"
+2 SET RORSUM(SUMMARY,VAL)=$GET(RORSUM(SUMMARY,VAL))+1
+3 QUIT
+4 ;
+5 ;***** ADDS THE PATIENT DATA TO THE REPORT
+6 ;
+7 ; IENS IENS of the patient's record in the registry
+8 ; PARTAG Reference (IEN) to the parent tag
+9 ;
+10 ; Return Values:
+11 ; <0 Error code
+12 ; 0 Ok
+13 ; >0 Skip the patient
+14 ;
PATIENT(IENS,PARTAG) ;
+1 NEW DFN,IEN,NAME,PTAG,RC,RORBUF,RORMSG,TMP,UTIL,VA,VADM,VAERR,VAHOW,VAPTYP,VAROOT
+2 SET RC=0
+3 ;
+4 ;--- Get the data from the ROR REGISTRY RECORD file
+5 IF $GET(RORFL798)'=""
Begin DoDot:1
+6 DO GETS^DIQ(798,IENS,RORFL798,"I","RORBUF","RORMSG")
+7 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798,IENS)
End DoDot:1
if RC<0
QUIT RC
+8 SET DFN=$GET(RORBUF(798,IENS,.01,"I"))
+9 ;
+10 ;--- Skip a patient without utilization
+11 SET UTIL=$$UTIL^RORXU003(RORSDT,ROREDT,DFN,.RORUTIL)
+12 if 'UTIL
QUIT 1
+13 ;
+14 ;--- Get the data from the ROR HIV STUDY file
+15 IF $GET(RORFLICR)'=""
Begin DoDot:1
+16 DO GETS^DIQ(799.4,IENS,RORFLICR,"I","RORBUF","RORMSG")
+17 IF $GET(DIERR)
IF '$DATA(RORMSG("DIERR","E",601))
Begin DoDot:2
+18 SET RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
End DoDot:2
QUIT
End DoDot:1
if RC<0
QUIT RC
+19 ;
+20 ;--- Load the demographic data
+21 DO 2^VADPT
+22 ;
+23 ;--- The <PATIENT> tag
+24 SET PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
+25 if PTAG<0
QUIT PTAG
SET RORSUM=$GET(RORSUM)+1
+26 ;--- Patient Name
+27 DO ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
+28 ;--- SSN or LAST4
+29 IF $$OPTCOL^RORXU006("SSN")
Begin DoDot:1
+30 SET $PIECE(VADM(2),U)="000000000"
DO ADDVAL^RORTSK11(RORTSK,"SSN",$PIECE(VADM(2),U),PTAG,2)
End DoDot:1
+31 IF '$TEST
SET VA("BID")="0000"
DO ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
+32 ;
+33 ;--- Date of Birth
+34 if $$OPTCOL^RORXU006("DOB")
Begin DoDot:1
+35 SET TMP=$$DATE^RORXU002(VADM(3)\1)
+36 DO ADDVAL^RORTSK11(RORTSK,"DOB",TMP,PTAG,1)
+37 SET TMP=$PIECE($$FMTE^XLFDT(TMP,7),"/")
+38 DO INCSUM("DOB",$SELECT(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
End DoDot:1
+39 ;
+40 ;--- Age
+41 if $$OPTCOL^RORXU006("AGE")
Begin DoDot:1
+42 ; Date of Death
SET TMP=+$GET(VADM(6))
+43 SET TMP=$SELECT(TMP'>0:RORAGEDT,TMP<RORAGEDT:TMP,1:RORAGEDT)
+44 SET TMP=$$FMDIFF^XLFDT(TMP,+VADM(3))\365
+45 DO ADDVAL^RORTSK11(RORTSK,"AGE",$SELECT(TMP>0:TMP,1:""),PTAG,1)
+46 if TMP'>0
QUIT
+47 SET RORSUM("AGE")=$GET(RORSUM("AGE"))+1
+48 SET RORSUM("AGE","Average")=$GET(RORSUM("AGE","Average"))+TMP
+49 DO INCSUM("AGE",TMP-(TMP#10))
End DoDot:1
+50 ;
+51 ;--- Birth Sex
+52 if $$OPTCOL^RORXU006("BIRTHSEX")
Begin DoDot:1
+53 SET TMP=$PIECE(VADM(5),U,2)
+54 DO ADDVAL^RORTSK11(RORTSK,"BIRTHSEX",TMP,PTAG,1)
+55 DO INCSUM("BIRTHSEX",TMP)
End DoDot:1
+56 ;
+57 ;--- Race
+58 if $$OPTCOL^RORXU006("RACE")
Begin DoDot:1
+59 NEW I,SUMVAL,TABLE
+60 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"RACES",,PTAG)
+61 IF $GET(VADM(12))>0
SET I=""
Begin DoDot:2
+62 FOR
SET I=$ORDER(VADM(12,I))
if I=""
QUIT
Begin DoDot:3
+63 SET SUMVAL=$PIECE(VADM(12,I),U,2)
+64 DO ADDVAL^RORTSK11(RORTSK,"RACE",SUMVAL,TABLE)
End DoDot:3
+65 if VADM(12)>1
SET SUMVAL="MULTIPLE VALUES"
End DoDot:2
+66 IF '$TEST
DO ADDVAL^RORTSK11(RORTSK,"RACE",,TABLE)
+67 DO INCSUM("RACE",$GET(SUMVAL))
End DoDot:1
+68 ;
+69 ;--- Ethnicity
+70 if $$OPTCOL^RORXU006("RACE")
Begin DoDot:1
+71 NEW I,SUMVAL,TABLE
+72 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"ETHNS",,PTAG)
+73 IF $GET(VADM(11))>0
SET I=""
Begin DoDot:2
+74 FOR
SET I=$ORDER(VADM(11,I))
if I=""
QUIT
Begin DoDot:3
+75 SET SUMVAL=$PIECE(VADM(11,I),U,2)
+76 DO ADDVAL^RORTSK11(RORTSK,"ETHN",SUMVAL,TABLE)
End DoDot:3
+77 if VADM(11)>1
SET SUMVAL="MULTIPLE VALUES"
End DoDot:2
+78 IF '$TEST
DO ADDVAL^RORTSK11(RORTSK,"ETHN",,TABLE)
+79 DO INCSUM("ETHN",$GET(SUMVAL))
End DoDot:1
+80 ;
+81 ;--- Risk factors
+82 if $$OPTCOL^RORXU006("RISK")
Begin DoDot:1
+83 NEW I,RISKS
+84 SET RISKS=$$RISKS^RORXU005(+IENS)
if RISKS<0
SET RISKS=""
+85 DO ADDVAL^RORTSK11(RORTSK,"RISK",RISKS,PTAG)
+86 SET RISKS=$TRANSLATE(RISKS," ")
+87 FOR I=1:1
SET TMP=$PIECE(RISKS,",",I)
if TMP'>0
QUIT
Begin DoDot:2
+88 SET RORRISK(TMP)=$GET(RORRISK(TMP))+1
End DoDot:2
End DoDot:1
+89 ;
+90 ;--- Date Selected
+91 if $$OPTCOL^RORXU006("SELDT")
Begin DoDot:1
+92 SET TMP=$$DATE^RORXU002($GET(RORBUF(798,IENS,3.2,"I"))\1)
+93 DO ADDVAL^RORTSK11(RORTSK,"SELDT",TMP,PTAG,1)
+94 SET TMP=$PIECE($$FMTE^XLFDT(TMP,7),"/")
+95 DO INCSUM("SELDT",$SELECT(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
End DoDot:1
+96 ;
+97 ;--- Date Confirmed
+98 if $$OPTCOL^RORXU006("CONFDT")
Begin DoDot:1
+99 SET TMP=$$DATE^RORXU002($GET(RORBUF(798,IENS,2,"I"))\1)
+100 DO ADDVAL^RORTSK11(RORTSK,"CONFDT",TMP,PTAG,1)
+101 SET TMP=$PIECE($$FMTE^XLFDT(TMP,7),"/")
+102 DO INCSUM("CONFDT",$SELECT(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
End DoDot:1
+103 ;
+104 ;--- Utilization
+105 if $$OPTCOL^RORXU006("UTIL")
Begin DoDot:1
+106 SET TMP=$$UTLCODES($PIECE(UTIL,U,2,999))
+107 DO ADDVAL^RORTSK11(RORTSK,"UTIL",TMP,PTAG)
End DoDot:1
+108 ;
+109 ;--- Date of Death
+110 if $$OPTCOL^RORXU006("DOD")
Begin DoDot:1
+111 SET TMP=$$DATE^RORXU002(VADM(6)\1)
+112 DO ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
+113 SET TMP=$PIECE($$FMTE^XLFDT(TMP,7),"/")
+114 DO INCSUM("DOD",$SELECT(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
End DoDot:1
+115 ;
+116 ;--- ICN
+117 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:1
+118 if '$DATA(DFN)
SET DFN=$GET(RORBUF(798,IENS,.01,"I"))
+119 DO ICNDATA^RORXU006(RORTSK,DFN,PTAG)
End DoDot:1
+120 ;--- PACT
+121 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:1
+122 if '$DATA(DFN)
SET DFN=$GET(RORBUF(798,IENS,.01,"I"))
+123 DO PACTDATA^RORXU006(RORTSK,DFN,PTAG)
End DoDot:1
+124 ;
+125 ;--- PCP
+126 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:1
+127 if '$DATA(DFN)
SET DFN=$GET(RORBUF(798,IENS,.01,"I"))
+128 DO PCPDATA^RORXU006(RORTSK,DFN,PTAG)
End DoDot:1
+129 QUIT 0
+130 ;
+131 ;***** GENERATES THE REPORT SUMMARY
+132 ;
+133 ; PARTAG Reference (IEN) to the parent tag
+134 ;
+135 ; PATIENTS Reference (IEN) to the PATIENTS tag
+136 ;
+137 ; Return Values:
+138 ; <0 Error code
+139 ; 0 Ok
+140 ;
SUMMARY(PARTAG,PATIENTS) ;
+1 NEW AGE,I,RC,RORBUF,SI,SUMMARY,TABLE,TAG,TMP
+2 SET SUMMARY=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PARTAG)
+3 if SUMMARY<0
QUIT SUMMARY
+4 ;
+5 ;--- Risk factors
+6 if $DATA(RORRISK)>1
Begin DoDot:1
+7 KILL RORBUF
DO BLD^DIALOG(7980000.016,.RORRISK,,"RORBUF")
+8 DO ADDTEXT^RORTSK11(RORTSK,"RISK_FACTORS",.RORBUF,SUMMARY)
End DoDot:1
+9 ;
+10 ;--- Simple summaries
+11 FOR SI="RACE","ETHN","BIRTHSEX"
if $DATA(RORSUM(SI))>1
Begin DoDot:1
+12 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
+13 SET I=""
+14 FOR
SET I=$ORDER(RORSUM(SI,I))
if I=""
QUIT
Begin DoDot:2
+15 SET TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
+16 DO ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
End DoDot:2
End DoDot:1
+17 ;
+18 ;--- Date summaries
+19 FOR SI="DOB","DOD","CONFDT","SELDT"
if $DATA(RORSUM(SI))>1
Begin DoDot:1
+20 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
+21 if $GET(RORSUM(SI,0))>0
Begin DoDot:2
+22 SET TAG=$$ADDVAL^RORTSK11(RORTSK,SI,"Before "_RORDTE0,TABLE)
+23 DO ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,0))
End DoDot:2
+24 SET I=0
+25 FOR
SET I=$ORDER(RORSUM(SI,I))
if I=""
QUIT
Begin DoDot:2
+26 SET TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
+27 DO ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
End DoDot:2
End DoDot:1
+28 ;
+29 ;--- Age summary
+30 IF $GET(RORSUM("AGE"))>0
Begin DoDot:1
+31 ;--- Average age
+32 SET TMP=$GET(RORSUM("AGE","Average"))/RORSUM("AGE")
+33 SET RORSUM("AGE","Average")=$JUSTIFY(TMP,0,2)
+34 ;--- Median age
+35 SET TMP=$$XREFNODE^RORTSK10(RORTSK,PATIENTS,"AGE")
+36 if TMP'=""
SET TMP=$$XREFMDNV^RORXU004(TMP,RORSUM("AGE"))
+37 SET RORSUM("AGE","Median")=$SELECT(TMP'="":$JUSTIFY(TMP,0,2),1:"")
+38 ;--- Output the table
+39 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"AGE_SUMMARY",,SUMMARY)
+40 SET I=""
+41 FOR
SET I=$ORDER(RORSUM("AGE",I))
if I=""
QUIT
Begin DoDot:2
+42 SET TAG=$$ADDVAL^RORTSK11(RORTSK,"AGE",$SELECT(+I=I:I_"+",1:I),TABLE)
+43 DO ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM("AGE",I))
End DoDot:2
End DoDot:1
+44 ;
+45 ;--- Utilization codes
+46 if $DATA(RORUCNT)>1
Begin DoDot:1
+47 KILL RORBUF
DO BLD^DIALOG(7980000.017,.RORUCNT,,"RORBUF")
+48 DO ADDTEXT^RORTSK11(RORTSK,"UTIL_CODES",.RORBUF,SUMMARY)
End DoDot:1
+49 ;---
+50 QUIT 0
+51 ;
+52 ;***** PROCESSES UTILIZATION CODES
UTLCODES(UCSRC) ;
+1 NEW I,UCLST,UC
SET UCLST=""
+2 FOR I=1:1
SET UC=$PIECE(UCSRC,U,I)
if UC=""
QUIT
Begin DoDot:1
+3 SET UCLST=UCLST_", "_UC
SET RORUCNT(UC)=$GET(RORUCNT(UC))+1
End DoDot:1
+4 QUIT $PIECE(UCLST,", ",2,999)
