- 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 Feb 18, 2025@23:10:41 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)