- RORX013A ;HCIOFO/SG - DIAGNOSIS CODES (QUERY & SORT) ;6/21/06 2:24pm
- ;;1.5;CLINICAL CASE REGISTRIES;**1,13,19,21,25,31,34,39**;Feb 17, 2006;Build 4
- ;
- ; This routine uses the following IAs:
- ;
- ; #928 ACTIVE^GMPLUTL (controlled)
- ; #1554 POV^PXAPIIB (controlled)
- ; #1905 SELECTED^VSIT (controlled)
- ; #2977 GETFLDS^GMPLEDT3 (controlled)
- ; #3157 RPC^DGPTFAPI (supported)
- ; #3545 Access to the "AAD" cross-reference and the field 80 (private)
- ; #92 ^DGPT(IEN,0) (controlled)
- ; #5747 $$CODEN^ICDEX, $$CODEC^ICDEX, $$VSTD^ICDEX (controlled)
- ; #6130 PTFICD^DGPTFUT
- ;
- ;******************************************************************************
- ;******************************************************************************
- ; --- ROUTINE MODIFICATION LOG ---
- ;
- ;PKG/PATCH DATE DEVELOPER MODIFICATION
- ;----------- ---------- ----------- ----------------------------------------
- ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
- ; clinics, or divisions for the report.
- ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
- ;ROR*1.5*21 SEP 2013 T KOPP Add Utilization date range to the report
- ; Add ICN to report, if requested
- ;ROR*1.5*25 OCT 2014 T KOPP Added PTF ICD-10 support for 25 diagnoses
- ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
- ; identifiers.
- ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN values
- ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
- ;******************************************************************************
- ;******************************************************************************
- Q
- ;
- ;**** STORES THE ICD CODE
- ;
- ; PATIEN Patient IEN (DFN)
- ; SOURCE ICD source code ("I", "O", "PB")
- ; [ICDIEN] IEN of the ICD descriptor in file #80
- ; DATE Date when the code was entered
- ; [ICD] ICD code
- ;
- ; Either the ICDIEN or the ICD parameter must be provided.
- ;
- ICDSET(PATIEN,SOURCE,ICDIEN,DATE,ICD) ;
- Q:DATE'>0
- N TMP
- S ICDIEN=+$G(ICDIEN)
- I ICDIEN'>0 Q:$G(ICD)="" D Q:ICDIEN'>0
- . S ICDIEN=+$$CODEN^ICDEX(ICD,80)
- ;---
- Q:$$ICDGRCHK^RORXU008(.RORPTGRP,ICDIEN,RORICDL)
- ;---
- S TMP=+$G(@RORTMP@("PAT",PATIEN,ICDIEN))
- S:'TMP!(DATE<TMP) @RORTMP@("PAT",PATIEN,ICDIEN)=DATE_U_SOURCE
- S ^(SOURCE)=$G(@RORTMP@("PAT",PATIEN,ICDIEN,SOURCE))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- Q
- ;
- ;***** SEARCHES FOR INPATIENT DIAGNOSES
- ;
- ; PATIEN Patient IEN (DFN)
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ; >0 Number of non-fatal errors
- ;
- INPAT(PATIEN) ;
- N ADMDT,DISDT,I,IEN,NODE,RC,RORBUF,RORMSG,DIERR,TMP
- S NODE=$NA(^DGPT("AAD",+PATIEN))
- S RC=0
- ;--- Browse through the admissions
- S ADMDT=ROREDT1
- F S ADMDT=$O(@NODE@(ADMDT),-1) Q:ADMDT'>0 D Q:RC
- . S IEN=""
- . F S IEN=$O(@NODE@(ADMDT,IEN),-1) Q:IEN'>0 D Q:RC
- . . Q:+$G(^DGPT(IEN,0))'=PATIEN
- . . Q:$$PTF^RORXU001(IEN,"FP",,.DISDT)
- . . ;--- Skip invalid and/or incomplete admissions
- . . I DISDT'>0 D Q:TMP!(DISDT'>0)
- . . . S TMP=$$CHKADM^RORXU001(PATIEN,ADMDT,.DISDT)
- . . ;--- Check if any appropriate admissions are left
- . . I DISDT<RORSDT S RC=1 Q
- . . Q:DISDT'<ROREDT1
- . . ;--- Load and process the admission data
- . . K RORBUF D RPC^DGPTFAPI(.RORBUF,IEN)
- . . I $G(RORBUF(0))<0 D Q
- . . . D ERROR^RORERR(-57,,,,RORBUF(0),"RPC^DGPTFAPI")
- . . S TMP=$P($G(RORBUF(1)),U,3)
- . . D:TMP'="" ICDSET(PATIEN,"I",,DISDT,TMP) ; ICD1
- . . D:$G(RORBUF(2))'="" ; ICD2 - ICD24
- . . . F I=1:1:24 S TMP=$P(RORBUF(2),U,I) D:TMP'=""
- . . . . D ICDSET(PATIEN,"I",,DISDT,TMP)
- . . S TMP=+$$GET1^DIQ(45,IEN,80,"I",,"RORMSG")
- . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,45,IEN)
- . . D:TMP>0 ICDSET(PATIEN,"I",TMP,DISDT) ; PRINCIPAL DIAGNOSIS
- ;---
- Q $S(RC<0:RC,1:0)
- ;
- ;***** SEARCHES FOR OUTPATIENT DIAGNOSES
- ;
- ; PATIEN Patient IEN (DFN)
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ; >0 Number of non-fatal errors
- ;
- OUTPAT(PATIEN) ;
- N DATE,ICDIEN,RC,RORMSG,RORVPLST,TMP,VPIEN,VSIEN,VSIT
- D SELECTED^VSIT(PATIEN,RORSDT,ROREDT)
- ;--- Browse through the visits
- S (VSIEN,RC)=0
- F S VSIEN=$O(^TMP("VSIT",$J,VSIEN)) Q:VSIEN="" D Q:RC<0
- . S TMP=+$O(^TMP("VSIT",$J,VSIEN,"")) Q:TMP'>0
- . S DATE=$P($G(^TMP("VSIT",$J,VSIEN,TMP)),U) Q:DATE'>0
- . ;--- Get a list of V POV records
- . D POV^PXAPIIB(VSIEN,.RORVPLST)
- . ;--- Process the records
- . S (VPIEN,RC)=0
- . F S VPIEN=$O(RORVPLST(VPIEN)) Q:VPIEN'>0 D Q:RC
- . . S ICDIEN=+$P(RORVPLST(VPIEN),U)
- . . D:ICDIEN>0 ICDSET(PATIEN,"O",ICDIEN,DATE)
- Q $S(RC<0:RC,1:0)
- ;
- ;***** SEARCHES FOR PROBLEMS
- ;
- ; PATIEN Patient IEN (DFN)
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ; >0 Number of non-fatal errors
- ;
- PROBLEM(PATIEN) ;
- N DATE,GMPFLD,GMPORIG,GMPROV,GMPVAMC,ICDIEN,IEN,IS,RC,RORPLST,TMP
- ;--- Load a list of active problems
- D ACTIVE^GMPLUTL(PATIEN,.RORPLST)
- ;--- Browse through the problems
- S (GMPVAMC,GMPROV)=0
- S (IS,RC)=0
- F S IS=$O(RORPLST(IS)) Q:IS="" D Q:RC
- . S IEN=+$G(RORPLST(IS,0)) Q:IEN'>0
- . K GMPFLD,GMPORIG D GETFLDS^GMPLEDT3(IEN)
- . S ICDIEN=+$G(GMPFLD(.01)) Q:ICDIEN'>0
- . S DATE=$P($G(GMPFLD(.08)),U)
- . D:(DATE'<RORSDT)&(DATE<ROREDT1) ICDSET(PATIEN,"PB",ICDIEN,DATE)
- Q 0
- ;
- ;***** QUERIES THE REGISTRY
- ;
- ; FLAGS Flags for the $$SKIP^RORXU005
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ; >0 Number of non-fatal errors
- ;
- QUERY(FLAGS) ;
- N RORAPPTINFO ; Future appointmentdate_U_clinicname
- N RORAPPT ; Future appointment date
- N RORCLIN ; Future appointment clinic name
- N RORDOD ; Date of death
- N ROREDT1 ; Day after the end date
- N RORLAST4 ; Last 4 digits of the current patient's SSN
- N RORPNAME ; Name of the current patient
- N RORICN ; ICN of patient (optional)
- N RORPACT ; PACT of patient (optional)
- N RORPCP ; PCP of patient (optional)
- N RORPTGRP ; Temporary list of ICD groups
- N RORPTN ; Number of patients in the registry
- N RORCDLIST ; Flag to indicate whether a clinic or division list exists
- N RORCDSTDT ; Start date for clinic/division utilization search
- N RORCDENDT ; End date for clinic/division utilization search
- ;
- N CNT,ECNT,IEN,IENS,PATIEN,RC,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE,AGE,AGETYPE
- ;--- Utilization date range
- D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
- . S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
- . S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
- . ;--- Combined date range
- . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
- . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
- S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
- S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
- S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
- S (CNT,ECNT,RC)=0
- ;
- ;=== Set up Clinic/Division list parameters
- S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
- ;
- ;--- Browse through the registry records
- S IEN=0
- F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
- . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
- . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
- . S IENS=IEN_",",CNT=CNT+1
- . ;--- Get patient DFN
- . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
- . ;check for patient list and quit if not on list
- . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
- . ;--- Check if the patient should be skipped
- . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
- . ;
- . ;--- Check for Clinic or Division list and quit if not in list
- . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
- . ;
- . ;--- Check for any utilization in the corresponding date range
- . I $$PARAM^RORTSK01("PATIENTS","CAREONLY") D Q:'UTIL
- . . K TMP S TMP("ALL")=1
- . . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
- . ;
- . M RORPTGRP=RORIGRP("C")
- . ;
- . ;--- Inpatient codes
- . S RC=$$INPAT(PATIEN)
- . I RC Q:RC<0 S ECNT=ECNT+RC
- . ;
- . ;--- Outpatient codes
- . S RC=$$OUTPAT(PATIEN)
- . I RC Q:RC<0 S ECNT=ECNT+RC
- . ;
- . ;--- Problem list
- . S RC=$$PROBLEM(PATIEN)
- . I RC Q:RC<0 S ECNT=ECNT+RC
- . ;
- . ;--- Skip the patient if no data has been found
- . Q:$D(@RORTMP@("PAT",PATIEN))<10
- . ;--- No ICD from some groups
- . I $D(RORPTGRP)>1 K @RORTMP@("PAT",PATIEN) Q
- . ;
- . ;--- Get the patient's data
- . D VADEM^RORUTL05(PATIEN,1)
- . S RORPNAME=VADM(1),RORDOD=$$DATE^RORXU002($P(VADM(6),U)\1),RORLAST4="0000"
- . I $$PARAM^RORTSK01("PATIENTS","ICN") S RORICN=$$ICN^RORUTL02(PATIEN)
- . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
- . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
- . I $$PARAM^RORTSK01("PATIENTS","PACT") S RORPACT=$$PACT^RORUTL02(PATIEN)
- . I $$PARAM^RORTSK01("PATIENTS","PCP") S RORPCP=$$PCP^RORUTL02(PATIEN)
- . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D ;patch 34
- . . S RORAPPTINFO=$$FUTAPPT^RORUTL02(PATIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
- . . S RORAPPT=$P(RORAPPTINFO,U,1),RORCLIN=$P(RORAPPTINFO,U,2)
- . ;--- Calculate the patient's totals
- . S RC=$$TOTALS(PATIEN)
- . I RC Q:RC<0 S ECNT=ECNT+RC
- ;---
- Q $S(RC<0:RC,1:ECNT)
- ;
- ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ; >0 Number of non-fatal errors
- ;
- SORT() ;
- N ICDIEN,TMP,TNC,TNDC
- ;---
- S ICDIEN=0,(TNC,TNDC)=0
- F S ICDIEN=$O(@RORTMP@("ICD",ICDIEN)) Q:ICDIEN'>0 D
- . S TNC=TNC+$G(@RORTMP@("ICD",ICDIEN,"C"))
- . S TNDC=TNDC+1
- S @RORTMP@("ICD")=TNC_U_TNDC
- ;---
- Q 0
- ;
- ;***** CALCULATES INTERMEDIATE TOTALS
- ;
- ; PATIEN Patient IEN (DFN)
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ; >0 Number of non-fatal errors
- ;
- TOTALS(PATIEN) ;
- N CNT,ICD,ICDIEN,ICDVST,PNODE,RC,TMP
- S PNODE=$NA(@RORTMP@("PAT",PATIEN))
- S @PNODE=RORLAST4_U_RORPNAME_U_RORDOD_U_$G(RORICN)_U_$G(RORPACT)_U_$G(RORPCP)_U_AGE_U_$G(RORAPPT)_U_$G(RORCLIN)
- S ^("PAT")=$G(@RORTMP@("PAT"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- ;
- S ICDIEN=0
- F S ICDIEN=$O(@PNODE@(ICDIEN)) Q:ICDIEN'>0 D
- . S ICD=$P($G(@RORTMP@("ICD",ICDIEN)),U)
- . I ICD="" D
- . . S ICD=$$CODEC^ICDEX(80,ICDIEN)
- . . S ICDVST=$$VSTD^ICDEX(ICDIEN)
- . . S:ICD="" ICD="UNKN"
- . . S:ICDVST="" ICDVST="Unknown ("_ICDIEN_")"
- . . S @RORTMP@("ICD",ICDIEN)=ICD_U_ICDVST
- . ;---
- . S CNT=0
- . F TMP="I","O","PB" S CNT=CNT+$G(@PNODE@(ICDIEN,TMP))
- . S @PNODE@(ICDIEN,"C")=CNT
- . S ^("C")=$G(@RORTMP@("ICD",ICDIEN,"C"))+CNT ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- . S ^("P")=$G(@RORTMP@("ICD",ICDIEN,"P"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX013A 11129 printed Jan 18, 2025@02:45:52 Page 2
- RORX013A ;HCIOFO/SG - DIAGNOSIS CODES (QUERY & SORT) ;6/21/06 2:24pm
- +1 ;;1.5;CLINICAL CASE REGISTRIES;**1,13,19,21,25,31,34,39**;Feb 17, 2006;Build 4
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ;
- +5 ; #928 ACTIVE^GMPLUTL (controlled)
- +6 ; #1554 POV^PXAPIIB (controlled)
- +7 ; #1905 SELECTED^VSIT (controlled)
- +8 ; #2977 GETFLDS^GMPLEDT3 (controlled)
- +9 ; #3157 RPC^DGPTFAPI (supported)
- +10 ; #3545 Access to the "AAD" cross-reference and the field 80 (private)
- +11 ; #92 ^DGPT(IEN,0) (controlled)
- +12 ; #5747 $$CODEN^ICDEX, $$CODEC^ICDEX, $$VSTD^ICDEX (controlled)
- +13 ; #6130 PTFICD^DGPTFUT
- +14 ;
- +15 ;******************************************************************************
- +16 ;******************************************************************************
- +17 ; --- ROUTINE MODIFICATION LOG ---
- +18 ;
- +19 ;PKG/PATCH DATE DEVELOPER MODIFICATION
- +20 ;----------- ---------- ----------- ----------------------------------------
- +21 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
- +22 ; clinics, or divisions for the report.
- +23 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
- +24 ;ROR*1.5*21 SEP 2013 T KOPP Add Utilization date range to the report
- +25 ; Add ICN to report, if requested
- +26 ;ROR*1.5*25 OCT 2014 T KOPP Added PTF ICD-10 support for 25 diagnoses
- +27 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
- +28 ; identifiers.
- +29 ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN values
- +30 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
- +31 ;******************************************************************************
- +32 ;******************************************************************************
- +33 QUIT
- +34 ;
- +35 ;**** STORES THE ICD CODE
- +36 ;
- +37 ; PATIEN Patient IEN (DFN)
- +38 ; SOURCE ICD source code ("I", "O", "PB")
- +39 ; [ICDIEN] IEN of the ICD descriptor in file #80
- +40 ; DATE Date when the code was entered
- +41 ; [ICD] ICD code
- +42 ;
- +43 ; Either the ICDIEN or the ICD parameter must be provided.
- +44 ;
- ICDSET(PATIEN,SOURCE,ICDIEN,DATE,ICD) ;
- +1 if DATE'>0
- QUIT
- +2 NEW TMP
- +3 SET ICDIEN=+$GET(ICDIEN)
- +4 IF ICDIEN'>0
- if $GET(ICD)=""
- QUIT
- Begin DoDot:1
- +5 SET ICDIEN=+$$CODEN^ICDEX(ICD,80)
- End DoDot:1
- if ICDIEN'>0
- QUIT
- +6 ;---
- +7 if $$ICDGRCHK^RORXU008(.RORPTGRP,ICDIEN,RORICDL)
- QUIT
- +8 ;---
- +9 SET TMP=+$GET(@RORTMP@("PAT",PATIEN,ICDIEN))
- +10 if 'TMP!(DATE<TMP)
- SET @RORTMP@("PAT",PATIEN,ICDIEN)=DATE_U_SOURCE
- +11 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- SET ^(SOURCE)=$GET(@RORTMP@("PAT",PATIEN,ICDIEN,SOURCE))+1
- +12 QUIT
- +13 ;
- +14 ;***** SEARCHES FOR INPATIENT DIAGNOSES
- +15 ;
- +16 ; PATIEN Patient IEN (DFN)
- +17 ;
- +18 ; Return Values:
- +19 ; <0 Error code
- +20 ; 0 Ok
- +21 ; >0 Number of non-fatal errors
- +22 ;
- INPAT(PATIEN) ;
- +1 NEW ADMDT,DISDT,I,IEN,NODE,RC,RORBUF,RORMSG,DIERR,TMP
- +2 SET NODE=$NAME(^DGPT("AAD",+PATIEN))
- +3 SET RC=0
- +4 ;--- Browse through the admissions
- +5 SET ADMDT=ROREDT1
- +6 FOR
- SET ADMDT=$ORDER(@NODE@(ADMDT),-1)
- if ADMDT'>0
- QUIT
- Begin DoDot:1
- +7 SET IEN=""
- +8 FOR
- SET IEN=$ORDER(@NODE@(ADMDT,IEN),-1)
- if IEN'>0
- QUIT
- Begin DoDot:2
- +9 if +$GET(^DGPT(IEN,0))'=PATIEN
- QUIT
- +10 if $$PTF^RORXU001(IEN,"FP",,.DISDT)
- QUIT
- +11 ;--- Skip invalid and/or incomplete admissions
- +12 IF DISDT'>0
- Begin DoDot:3
- +13 SET TMP=$$CHKADM^RORXU001(PATIEN,ADMDT,.DISDT)
- End DoDot:3
- if TMP!(DISDT'>0)
- QUIT
- +14 ;--- Check if any appropriate admissions are left
- +15 IF DISDT<RORSDT
- SET RC=1
- QUIT
- +16 if DISDT'<ROREDT1
- QUIT
- +17 ;--- Load and process the admission data
- +18 KILL RORBUF
- DO RPC^DGPTFAPI(.RORBUF,IEN)
- +19 IF $GET(RORBUF(0))<0
- Begin DoDot:3
- +20 DO ERROR^RORERR(-57,,,,RORBUF(0),"RPC^DGPTFAPI")
- End DoDot:3
- QUIT
- +21 SET TMP=$PIECE($GET(RORBUF(1)),U,3)
- +22 ; ICD1
- if TMP'=""
- DO ICDSET(PATIEN,"I",,DISDT,TMP)
- +23 ; ICD2 - ICD24
- if $GET(RORBUF(2))'=""
- Begin DoDot:3
- +24 FOR I=1:1:24
- SET TMP=$PIECE(RORBUF(2),U,I)
- if TMP'=""
- Begin DoDot:4
- +25 DO ICDSET(PATIEN,"I",,DISDT,TMP)
- End DoDot:4
- End DoDot:3
- +26 SET TMP=+$$GET1^DIQ(45,IEN,80,"I",,"RORMSG")
- +27 if $GET(DIERR)
- DO DBS^RORERR("RORMSG",-9,,,45,IEN)
- +28 ; PRINCIPAL DIAGNOSIS
- if TMP>0
- DO ICDSET(PATIEN,"I",TMP,DISDT)
- End DoDot:2
- if RC
- QUIT
- End DoDot:1
- if RC
- QUIT
- +29 ;---
- +30 QUIT $SELECT(RC<0:RC,1:0)
- +31 ;
- +32 ;***** SEARCHES FOR OUTPATIENT DIAGNOSES
- +33 ;
- +34 ; PATIEN Patient IEN (DFN)
- +35 ;
- +36 ; Return Values:
- +37 ; <0 Error code
- +38 ; 0 Ok
- +39 ; >0 Number of non-fatal errors
- +40 ;
- OUTPAT(PATIEN) ;
- +1 NEW DATE,ICDIEN,RC,RORMSG,RORVPLST,TMP,VPIEN,VSIEN,VSIT
- +2 DO SELECTED^VSIT(PATIEN,RORSDT,ROREDT)
- +3 ;--- Browse through the visits
- +4 SET (VSIEN,RC)=0
- +5 FOR
- SET VSIEN=$ORDER(^TMP("VSIT",$JOB,VSIEN))
- if VSIEN=""
- QUIT
- Begin DoDot:1
- +6 SET TMP=+$ORDER(^TMP("VSIT",$JOB,VSIEN,""))
- if TMP'>0
- QUIT
- +7 SET DATE=$PIECE($GET(^TMP("VSIT",$JOB,VSIEN,TMP)),U)
- if DATE'>0
- QUIT
- +8 ;--- Get a list of V POV records
- +9 DO POV^PXAPIIB(VSIEN,.RORVPLST)
- +10 ;--- Process the records
- +11 SET (VPIEN,RC)=0
- +12 FOR
- SET VPIEN=$ORDER(RORVPLST(VPIEN))
- if VPIEN'>0
- QUIT
- Begin DoDot:2
- +13 SET ICDIEN=+$PIECE(RORVPLST(VPIEN),U)
- +14 if ICDIEN>0
- DO ICDSET(PATIEN,"O",ICDIEN,DATE)
- End DoDot:2
- if RC
- QUIT
- End DoDot:1
- if RC<0
- QUIT
- +15 QUIT $SELECT(RC<0:RC,1:0)
- +16 ;
- +17 ;***** SEARCHES FOR PROBLEMS
- +18 ;
- +19 ; PATIEN Patient IEN (DFN)
- +20 ;
- +21 ; Return Values:
- +22 ; <0 Error code
- +23 ; 0 Ok
- +24 ; >0 Number of non-fatal errors
- +25 ;
- PROBLEM(PATIEN) ;
- +1 NEW DATE,GMPFLD,GMPORIG,GMPROV,GMPVAMC,ICDIEN,IEN,IS,RC,RORPLST,TMP
- +2 ;--- Load a list of active problems
- +3 DO ACTIVE^GMPLUTL(PATIEN,.RORPLST)
- +4 ;--- Browse through the problems
- +5 SET (GMPVAMC,GMPROV)=0
- +6 SET (IS,RC)=0
- +7 FOR
- SET IS=$ORDER(RORPLST(IS))
- if IS=""
- QUIT
- Begin DoDot:1
- +8 SET IEN=+$GET(RORPLST(IS,0))
- if IEN'>0
- QUIT
- +9 KILL GMPFLD,GMPORIG
- DO GETFLDS^GMPLEDT3(IEN)
- +10 SET ICDIEN=+$GET(GMPFLD(.01))
- if ICDIEN'>0
- QUIT
- +11 SET DATE=$PIECE($GET(GMPFLD(.08)),U)
- +12 if (DATE'<RORSDT)&(DATE<ROREDT1)
- DO ICDSET(PATIEN,"PB",ICDIEN,DATE)
- End DoDot:1
- if RC
- QUIT
- +13 QUIT 0
- +14 ;
- +15 ;***** QUERIES THE REGISTRY
- +16 ;
- +17 ; FLAGS Flags for the $$SKIP^RORXU005
- +18 ;
- +19 ; Return Values:
- +20 ; <0 Error code
- +21 ; 0 Ok
- +22 ; >0 Number of non-fatal errors
- +23 ;
- QUERY(FLAGS) ;
- +1 ; Future appointmentdate_U_clinicname
- NEW RORAPPTINFO
- +2 ; Future appointment date
- NEW RORAPPT
- +3 ; Future appointment clinic name
- NEW RORCLIN
- +4 ; Date of death
- NEW RORDOD
- +5 ; Day after the end date
- NEW ROREDT1
- +6 ; Last 4 digits of the current patient's SSN
- NEW RORLAST4
- +7 ; Name of the current patient
- NEW RORPNAME
- +8 ; ICN of patient (optional)
- NEW RORICN
- +9 ; PACT of patient (optional)
- NEW RORPACT
- +10 ; PCP of patient (optional)
- NEW RORPCP
- +11 ; Temporary list of ICD groups
- NEW RORPTGRP
- +12 ; Number of patients in the registry
- NEW RORPTN
- +13 ; Flag to indicate whether a clinic or division list exists
- NEW RORCDLIST
- +14 ; Start date for clinic/division utilization search
- NEW RORCDSTDT
- +15 ; End date for clinic/division utilization search
- NEW RORCDENDT
- +16 ;
- +17 NEW CNT,ECNT,IEN,IENS,PATIEN,RC,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE,AGE,AGETYPE
- +18 ;--- Utilization date range
- +19 if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
- Begin DoDot:1
- +20 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
- +21 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
- +22 ;--- Combined date range
- +23 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
- +24 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
- End DoDot:1
- +25 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
- +26 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
- if RORPTN<0
- SET RORPTN=0
- +27 SET ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
- +28 SET (CNT,ECNT,RC)=0
- +29 ;
- +30 ;=== Set up Clinic/Division list parameters
- +31 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
- +32 ;
- +33 ;--- Browse through the registry records
- +34 SET IEN=0
- +35 FOR
- SET IEN=$ORDER(@XREFNODE@(IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +36 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
- +37 SET RC=$$LOOP^RORTSK01(TMP)
- if RC<0
- QUIT
- +38 SET IENS=IEN_","
- SET CNT=CNT+1
- +39 ;--- Get patient DFN
- +40 SET PATIEN=$$PTIEN^RORUTL01(IEN)
- if PATIEN'>0
- QUIT
- +41 ;check for patient list and quit if not on list
- +42 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
- IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
- QUIT
- +43 ;--- Check if the patient should be skipped
- +44 if $$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
- QUIT
- +45 ;
- +46 ;--- Check for Clinic or Division list and quit if not in list
- +47 IF RORCDLIST
- IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
- QUIT
- +48 ;
- +49 ;--- Check for any utilization in the corresponding date range
- +50 IF $$PARAM^RORTSK01("PATIENTS","CAREONLY")
- Begin DoDot:2
- +51 KILL TMP
- SET TMP("ALL")=1
- +52 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
- End DoDot:2
- if 'UTIL
- QUIT
- +53 ;
- +54 MERGE RORPTGRP=RORIGRP("C")
- +55 ;
- +56 ;--- Inpatient codes
- +57 SET RC=$$INPAT(PATIEN)
- +58 IF RC
- if RC<0
- QUIT
- SET ECNT=ECNT+RC
- +59 ;
- +60 ;--- Outpatient codes
- +61 SET RC=$$OUTPAT(PATIEN)
- +62 IF RC
- if RC<0
- QUIT
- SET ECNT=ECNT+RC
- +63 ;
- +64 ;--- Problem list
- +65 SET RC=$$PROBLEM(PATIEN)
- +66 IF RC
- if RC<0
- QUIT
- SET ECNT=ECNT+RC
- +67 ;
- +68 ;--- Skip the patient if no data has been found
- +69 if $DATA(@RORTMP@("PAT",PATIEN))<10
- QUIT
- +70 ;--- No ICD from some groups
- +71 IF $DATA(RORPTGRP)>1
- KILL @RORTMP@("PAT",PATIEN)
- QUIT
- +72 ;
- +73 ;--- Get the patient's data
- +74 DO VADEM^RORUTL05(PATIEN,1)
- +75 SET RORPNAME=VADM(1)
- SET RORDOD=$$DATE^RORXU002($PIECE(VADM(6),U)\1)
- SET RORLAST4="0000"
- +76 IF $$PARAM^RORTSK01("PATIENTS","ICN")
- SET RORICN=$$ICN^RORUTL02(PATIEN)
- +77 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
- +78 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
- +79 IF $$PARAM^RORTSK01("PATIENTS","PACT")
- SET RORPACT=$$PACT^RORUTL02(PATIEN)
- +80 IF $$PARAM^RORTSK01("PATIENTS","PCP")
- SET RORPCP=$$PCP^RORUTL02(PATIEN)
- +81 ;patch 34
- IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
- Begin DoDot:2
- +82 SET RORAPPTINFO=$$FUTAPPT^RORUTL02(PATIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
- +83 SET RORAPPT=$PIECE(RORAPPTINFO,U,1)
- SET RORCLIN=$PIECE(RORAPPTINFO,U,2)
- End DoDot:2
- +84 ;--- Calculate the patient's totals
- +85 SET RC=$$TOTALS(PATIEN)
- +86 IF RC
- if RC<0
- QUIT
- SET ECNT=ECNT+RC
- End DoDot:1
- if RC<0
- QUIT
- +87 ;---
- +88 QUIT $SELECT(RC<0:RC,1:ECNT)
- +89 ;
- +90 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
- +91 ;
- +92 ; Return Values:
- +93 ; <0 Error code
- +94 ; 0 Ok
- +95 ; >0 Number of non-fatal errors
- +96 ;
- SORT() ;
- +1 NEW ICDIEN,TMP,TNC,TNDC
- +2 ;---
- +3 SET ICDIEN=0
- SET (TNC,TNDC)=0
- +4 FOR
- SET ICDIEN=$ORDER(@RORTMP@("ICD",ICDIEN))
- if ICDIEN'>0
- QUIT
- Begin DoDot:1
- +5 SET TNC=TNC+$GET(@RORTMP@("ICD",ICDIEN,"C"))
- +6 SET TNDC=TNDC+1
- End DoDot:1
- +7 SET @RORTMP@("ICD")=TNC_U_TNDC
- +8 ;---
- +9 QUIT 0
- +10 ;
- +11 ;***** CALCULATES INTERMEDIATE TOTALS
- +12 ;
- +13 ; PATIEN Patient IEN (DFN)
- +14 ;
- +15 ; Return Values:
- +16 ; <0 Error code
- +17 ; 0 Ok
- +18 ; >0 Number of non-fatal errors
- +19 ;
- TOTALS(PATIEN) ;
- +1 NEW CNT,ICD,ICDIEN,ICDVST,PNODE,RC,TMP
- +2 SET PNODE=$NAME(@RORTMP@("PAT",PATIEN))
- +3 SET @PNODE=RORLAST4_U_RORPNAME_U_RORDOD_U_$GET(RORICN)_U_$GET(RORPACT)_U_$GET(RORPCP)_U_AGE_U_$GET(RORAPPT)_U_$GET(RORCLIN)
- +4 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- SET ^("PAT")=$GET(@RORTMP@("PAT"))+1
- +5 ;
- +6 SET ICDIEN=0
- +7 FOR
- SET ICDIEN=$ORDER(@PNODE@(ICDIEN))
- if ICDIEN'>0
- QUIT
- Begin DoDot:1
- +8 SET ICD=$PIECE($GET(@RORTMP@("ICD",ICDIEN)),U)
- +9 IF ICD=""
- Begin DoDot:2
- +10 SET ICD=$$CODEC^ICDEX(80,ICDIEN)
- +11 SET ICDVST=$$VSTD^ICDEX(ICDIEN)
- +12 if ICD=""
- SET ICD="UNKN"
- +13 if ICDVST=""
- SET ICDVST="Unknown ("_ICDIEN_")"
- +14 SET @RORTMP@("ICD",ICDIEN)=ICD_U_ICDVST
- End DoDot:2
- +15 ;---
- +16 SET CNT=0
- +17 FOR TMP="I","O","PB"
- SET CNT=CNT+$GET(@PNODE@(ICDIEN,TMP))
- +18 SET @PNODE@(ICDIEN,"C")=CNT
- +19 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- SET ^("C")=$GET(@RORTMP@("ICD",ICDIEN,"C"))+CNT
- +20 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
- SET ^("P")=$GET(@RORTMP@("ICD",ICDIEN,"P"))+1
- End DoDot:1
- +21 QUIT 0