Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORX003A

RORX003A.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #10061 2^VADPT (supported)
  1. ;
  1. Q
  1. ;
  1. ;** MODIFICATIONS **
  1. ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
  1. ; additional identifier option selected
  1. ;ROR*1.5*30 OCT 2016 M FERRARESE Changing the display for "Sex" to "Birth Sex"
  1. ;
  1. ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
  1. ;
  1. ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
  1. ;**
  1. ;***** INCREMENTS SUMMARY COUNTER
  1. INCSUM(SUMMARY,VAL) ;
  1. S:$G(VAL)="" VAL="NO DATA"
  1. S RORSUM(SUMMARY,VAL)=$G(RORSUM(SUMMARY,VAL))+1
  1. Q
  1. ;
  1. ;***** ADDS THE PATIENT DATA TO THE REPORT
  1. ;
  1. ; IENS IENS of the patient's record in the registry
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Skip the patient
  1. ;
  1. PATIENT(IENS,PARTAG) ;
  1. N DFN,IEN,NAME,PTAG,RC,RORBUF,RORMSG,TMP,UTIL,VA,VADM,VAERR,VAHOW,VAPTYP,VAROOT
  1. S RC=0
  1. ;
  1. ;--- Get the data from the ROR REGISTRY RECORD file
  1. I $G(RORFL798)'="" D Q:RC<0 RC
  1. . D GETS^DIQ(798,IENS,RORFL798,"I","RORBUF","RORMSG")
  1. . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798,IENS)
  1. S DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. ;
  1. ;--- Skip a patient without utilization
  1. S UTIL=$$UTIL^RORXU003(RORSDT,ROREDT,DFN,.RORUTIL)
  1. Q:'UTIL 1
  1. ;
  1. ;--- Get the data from the ROR HIV STUDY file
  1. I $G(RORFLICR)'="" D Q:RC<0 RC
  1. . D GETS^DIQ(799.4,IENS,RORFLICR,"I","RORBUF","RORMSG")
  1. . I $G(DIERR),'$D(RORMSG("DIERR","E",601)) D Q
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
  1. ;
  1. ;--- Load the demographic data
  1. D 2^VADPT
  1. ;
  1. ;--- The <PATIENT> tag
  1. S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
  1. Q:PTAG<0 PTAG S RORSUM=$G(RORSUM)+1
  1. ;--- Patient Name
  1. D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
  1. ;--- SSN or LAST4
  1. I $$OPTCOL^RORXU006("SSN") D
  1. .S $P(VADM(2),U)="000000000" D ADDVAL^RORTSK11(RORTSK,"SSN",$P(VADM(2),U),PTAG,2)
  1. E S VA("BID")="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
  1. ;
  1. ;--- Date of Birth
  1. D:$$OPTCOL^RORXU006("DOB")
  1. . S TMP=$$DATE^RORXU002(VADM(3)\1)
  1. . D ADDVAL^RORTSK11(RORTSK,"DOB",TMP,PTAG,1)
  1. . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
  1. . D INCSUM("DOB",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
  1. ;
  1. ;--- Age
  1. D:$$OPTCOL^RORXU006("AGE")
  1. . S TMP=+$G(VADM(6)) ; Date of Death
  1. . S TMP=$S(TMP'>0:RORAGEDT,TMP<RORAGEDT:TMP,1:RORAGEDT)
  1. . S TMP=$$FMDIFF^XLFDT(TMP,+VADM(3))\365
  1. . D ADDVAL^RORTSK11(RORTSK,"AGE",$S(TMP>0:TMP,1:""),PTAG,1)
  1. . Q:TMP'>0
  1. . S RORSUM("AGE")=$G(RORSUM("AGE"))+1
  1. . S RORSUM("AGE","Average")=$G(RORSUM("AGE","Average"))+TMP
  1. . D INCSUM("AGE",TMP-(TMP#10))
  1. ;
  1. ;--- Birth Sex
  1. D:$$OPTCOL^RORXU006("BIRTHSEX")
  1. . S TMP=$P(VADM(5),U,2)
  1. . D ADDVAL^RORTSK11(RORTSK,"BIRTHSEX",TMP,PTAG,1)
  1. . D INCSUM("BIRTHSEX",TMP)
  1. ;
  1. ;--- Race
  1. D:$$OPTCOL^RORXU006("RACE")
  1. . N I,SUMVAL,TABLE
  1. . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"RACES",,PTAG)
  1. . I $G(VADM(12))>0 S I="" D
  1. . . F S I=$O(VADM(12,I)) Q:I="" D
  1. . . . S SUMVAL=$P(VADM(12,I),U,2)
  1. . . . D ADDVAL^RORTSK11(RORTSK,"RACE",SUMVAL,TABLE)
  1. . . S:VADM(12)>1 SUMVAL="MULTIPLE VALUES"
  1. . E D ADDVAL^RORTSK11(RORTSK,"RACE",,TABLE)
  1. . D INCSUM("RACE",$G(SUMVAL))
  1. ;
  1. ;--- Ethnicity
  1. D:$$OPTCOL^RORXU006("RACE")
  1. . N I,SUMVAL,TABLE
  1. . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"ETHNS",,PTAG)
  1. . I $G(VADM(11))>0 S I="" D
  1. . . F S I=$O(VADM(11,I)) Q:I="" D
  1. . . . S SUMVAL=$P(VADM(11,I),U,2)
  1. . . . D ADDVAL^RORTSK11(RORTSK,"ETHN",SUMVAL,TABLE)
  1. . . S:VADM(11)>1 SUMVAL="MULTIPLE VALUES"
  1. . E D ADDVAL^RORTSK11(RORTSK,"ETHN",,TABLE)
  1. . D INCSUM("ETHN",$G(SUMVAL))
  1. ;
  1. ;--- Risk factors
  1. D:$$OPTCOL^RORXU006("RISK")
  1. . N I,RISKS
  1. . S RISKS=$$RISKS^RORXU005(+IENS) S:RISKS<0 RISKS=""
  1. . D ADDVAL^RORTSK11(RORTSK,"RISK",RISKS,PTAG)
  1. . S RISKS=$TR(RISKS," ")
  1. . F I=1:1 S TMP=$P(RISKS,",",I) Q:TMP'>0 D
  1. . . S RORRISK(TMP)=$G(RORRISK(TMP))+1
  1. ;
  1. ;--- Date Selected
  1. D:$$OPTCOL^RORXU006("SELDT")
  1. . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,3.2,"I"))\1)
  1. . D ADDVAL^RORTSK11(RORTSK,"SELDT",TMP,PTAG,1)
  1. . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
  1. . D INCSUM("SELDT",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
  1. ;
  1. ;--- Date Confirmed
  1. D:$$OPTCOL^RORXU006("CONFDT")
  1. . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,2,"I"))\1)
  1. . D ADDVAL^RORTSK11(RORTSK,"CONFDT",TMP,PTAG,1)
  1. . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
  1. . D INCSUM("CONFDT",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
  1. ;
  1. ;--- Utilization
  1. D:$$OPTCOL^RORXU006("UTIL")
  1. . S TMP=$$UTLCODES($P(UTIL,U,2,999))
  1. . D ADDVAL^RORTSK11(RORTSK,"UTIL",TMP,PTAG)
  1. ;
  1. ;--- Date of Death
  1. D:$$OPTCOL^RORXU006("DOD")
  1. . S TMP=$$DATE^RORXU002(VADM(6)\1)
  1. . D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
  1. . S TMP=$P($$FMTE^XLFDT(TMP,7),"/")
  1. . D INCSUM("DOD",$S(TMP'<RORDTE0:TMP,TMP>0:0,1:""))
  1. ;
  1. ;--- ICN
  1. I $$PARAM^RORTSK01("PATIENTS","ICN") D
  1. . S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. . D ICNDATA^RORXU006(RORTSK,DFN,PTAG)
  1. ;--- PACT
  1. I $$PARAM^RORTSK01("PATIENTS","PACT") D
  1. . S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. . D PACTDATA^RORXU006(RORTSK,DFN,PTAG)
  1. ;
  1. ;--- PCP
  1. I $$PARAM^RORTSK01("PATIENTS","PCP") D
  1. . S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. . D PCPDATA^RORXU006(RORTSK,DFN,PTAG)
  1. Q 0
  1. ;
  1. ;***** GENERATES THE REPORT SUMMARY
  1. ;
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; PATIENTS Reference (IEN) to the PATIENTS tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. SUMMARY(PARTAG,PATIENTS) ;
  1. N AGE,I,RC,RORBUF,SI,SUMMARY,TABLE,TAG,TMP
  1. S SUMMARY=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PARTAG)
  1. Q:SUMMARY<0 SUMMARY
  1. ;
  1. ;--- Risk factors
  1. D:$D(RORRISK)>1
  1. . K RORBUF D BLD^DIALOG(7980000.016,.RORRISK,,"RORBUF")
  1. . D ADDTEXT^RORTSK11(RORTSK,"RISK_FACTORS",.RORBUF,SUMMARY)
  1. ;
  1. ;--- Simple summaries
  1. F SI="RACE","ETHN","BIRTHSEX" D:$D(RORSUM(SI))>1
  1. . S TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
  1. . S I=""
  1. . F S I=$O(RORSUM(SI,I)) Q:I="" D
  1. . . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
  1. . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
  1. ;
  1. ;--- Date summaries
  1. F SI="DOB","DOD","CONFDT","SELDT" D:$D(RORSUM(SI))>1
  1. . S TABLE=$$ADDVAL^RORTSK11(RORTSK,SI_"_SUMMARY",,SUMMARY)
  1. . D:$G(RORSUM(SI,0))>0
  1. . . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,"Before "_RORDTE0,TABLE)
  1. . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,0))
  1. . S I=0
  1. . F S I=$O(RORSUM(SI,I)) Q:I="" D
  1. . . S TAG=$$ADDVAL^RORTSK11(RORTSK,SI,I,TABLE)
  1. . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM(SI,I))
  1. ;
  1. ;--- Age summary
  1. I $G(RORSUM("AGE"))>0 D
  1. . ;--- Average age
  1. . S TMP=$G(RORSUM("AGE","Average"))/RORSUM("AGE")
  1. . S RORSUM("AGE","Average")=$J(TMP,0,2)
  1. . ;--- Median age
  1. . S TMP=$$XREFNODE^RORTSK10(RORTSK,PATIENTS,"AGE")
  1. . S:TMP'="" TMP=$$XREFMDNV^RORXU004(TMP,RORSUM("AGE"))
  1. . S RORSUM("AGE","Median")=$S(TMP'="":$J(TMP,0,2),1:"")
  1. . ;--- Output the table
  1. . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"AGE_SUMMARY",,SUMMARY)
  1. . S I=""
  1. . F S I=$O(RORSUM("AGE",I)) Q:I="" D
  1. . . S TAG=$$ADDVAL^RORTSK11(RORTSK,"AGE",$S(+I=I:I_"+",1:I),TABLE)
  1. . . D ADDATTR^RORTSK11(RORTSK,TAG,"COUNT",RORSUM("AGE",I))
  1. ;
  1. ;--- Utilization codes
  1. D:$D(RORUCNT)>1
  1. . K RORBUF D BLD^DIALOG(7980000.017,.RORUCNT,,"RORBUF")
  1. . D ADDTEXT^RORTSK11(RORTSK,"UTIL_CODES",.RORBUF,SUMMARY)
  1. ;---
  1. Q 0
  1. ;
  1. ;***** PROCESSES UTILIZATION CODES
  1. UTLCODES(UCSRC) ;
  1. N I,UCLST,UC S UCLST=""
  1. F I=1:1 S UC=$P(UCSRC,U,I) Q:UC="" D
  1. . S UCLST=UCLST_", "_UC,RORUCNT(UC)=$G(RORUCNT(UC))+1
  1. Q $P(UCLST,", ",2,999)