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

RORREP02.m

Go to the documentation of this file. 
  1. RORREP02 ;HCIOFO/BH - VERSION COMPARISON REPORT (ICR) ; 7/11/03 1:22pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  ;--------------------------------------------------------------------
  1.  ; Registry: [VA HIV]
  1.  ;--------------------------------------------------------------------
  1.  ;
  1. PRNT ;
  1.  N THREEH
  1.  S THREEH=1
  1.  D NOW^%DTC S IMRDTE=%,IMRPG="0"
  1.  K IMRDONE
  1.  S Y=IMRDTE D DD^%DT S IMRDTE=Y
  1.  D LIST("INTWO","Patients in ICR 2.1 and not in ROR:ICR")
  1.  Q:$D(IMRDONE)
  1.  D LIST("INTHREE","Patients in ROR:ICR and not in ICR 2.1")
  1.  Q:$D(IMRDONE)
  1.  D LIST("INBOTH","Patients in ROR:ICR and in ICR 2.1")
  1.  Q:$D(IMRDONE)
  1.  D LEGEND
  1.  Q:$D(IMRDONE)
  1.  D ISSUE
  1.  Q:$D(IMRDONE)
  1.  D ERROR
  1.  Q:$D(IMRDONE)
  1.  D ICNERR
  1.  K IMRDONE,TMP
  1.  Q
  1.  ;
  1. HEDR ; Header of Report
  1.  S X="ICR Version Comparison Report"
  1.  W:$Y>0 @IOF S IMRPG=IMRPG+1
  1.  W IMRDTE,?72,"Page ",IMRPG,!
  1.  W !," ",X,!
  1.  W " ",IMRHED
  1.  W !!
  1.  I TYPE="INTWO" D
  1.  . W "                           Last  Earliest Cat.",!
  1.  . W "Patient                    Four  Date (v 2.1)",!
  1.  . W "-------                    ----  -------------",!
  1.  ;
  1.  I TYPE="INTHREE" D
  1.  . I THREEH D
  1.  . . ;
  1.  . . W " ** Some of these patients are in a Pending state and need to be either      **"
  1.  . . W !," ** validated into the ICR registry or deleted via the ICR GUI.  Individual  **"
  1.  . . W !," ** patient data for pending patients will not be sent to AAC until they are **"
  1.  . . W !," ** validated into the registry.                                             **"
  1.  . . W !!
  1.  . . ;
  1.  . . S THREEH=0
  1.  . W "Patient                    Last Earliest Sel.     Location Selection",!
  1.  . W "                           Four Rule (ROR:ICR)    Rule Found (ROR:ICR)  Pending",!
  1.  . W "-------                    ---- --------------    --------------------  -------",!
  1.  .
  1.  ;
  1.  I TYPE="INBOTH" D
  1.  . W "                         Last Earliest Sel.  Location Selection    Earliest Cat.",!
  1.  . W "Patient                  Four Rule (ROR:ICR) Rule Found (ROR:ICR)  Date (v 2.1)",!
  1.  . W "-------                  ---- -------------- --------------------- -------------",!
  1.  Q
  1.  ;
  1. EHEAD ;
  1.  S X="ICR Version Comparison Report"
  1.  W:$Y>0 @IOF S IMRPG=IMRPG+1
  1.  W !,IMRDTE,?72,"Page ",IMRPG,!
  1.  W !,"  Patients with Errors.",!!
  1.  W " -----------------------",!!
  1.  ;
  1.  Q
  1.  ;
  1. ENDHEAD ;
  1.  S X="ICR Version Comparison Report"
  1.  W:$Y>0 @IOF S IMRPG=IMRPG+1
  1.  W IMRDTE,?72,"Page ",IMRPG,!
  1.  W !," ",X,!!
  1.  ;
  1.  W !," Legend.",!
  1.  W " -------",!!
  1.  W " Code                      Description",!
  1.  W " ----                      -----------"
  1.  Q
  1.  ;
  1. EVID ;  Heading for patients with no selection rules but with supporting
  1.  ;  Evidence.
  1.  S X="ICR Version Comparison Report"
  1.  W:$Y>0 @IOF S IMRPG=IMRPG+1
  1.  W IMRDTE,?72,"Page ",IMRPG,!
  1.  W !," ",X,!
  1.  W !,"** The following patient(s) are in the ROR Local Registry file (#798) but    **"
  1.  W !,"** have no selection rules but do have supporting evidence for being         **"
  1.  W !,"** manually added to the Registry.  Please consider adding HIV disease (042) **"
  1.  W !,"** to the patient's problem list.                                            **",!
  1.  Q
  1.  ;
  1. ICNHEAD ;
  1.  S X="ICR Version Comparison Report"
  1.  W:$Y>0 @IOF S IMRPG=IMRPG+1
  1.  W IMRDTE,?72,"Page ",IMRPG,!
  1.  W !," ",X,!!
  1.  ;
  1.  W "** The following Patients have local ICN's (Intergration Control Numbers)   **"
  1.  W !,"** and will not have data extracted and transmitted to the national ICR     **"
  1.  W !,"** database.  Since your facility's VERA reimbursement is calculated from   **"
  1.  W !,"** the National database, it is important that these patient records be     **"
  1.  W !,"** updated by the sites IRM with National ICNs.                             **"
  1.  W !!
  1.  W " Name                       Last Four",!
  1.  W " ----                       ---------"
  1.  Q
  1.  ;
  1.  ;
  1. LIST(TYPE,IMRHED) ; List patients missing data values
  1.  D HEDR
  1.  I '$D(^TMP("RORREP01",$J,TYPE)) D  Q
  1.  . W !!,"No patients found." D PRTC Q:$D(IMRDONE)
  1.  N NAME,DTE2,NEWNAME,TWOLOC,TWODATE,LOC3,LOC4,DATE3,BOTHLOC,BOTHDTE,DTE3,DATA,SSN
  1.  N RORTOTAL
  1.  Q:$D(IMRDONE)
  1.  S (NAME,RORTOTAL)=0
  1.  F  S NAME=$O(^TMP("RORREP01",$J,TYPE,NAME)) Q:NAME=""  D  Q:$D(IMRDONE)
  1.  . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE)  D HEDR
  1.  . S DATA=^TMP("RORREP01",$J,TYPE,NAME)
  1.  . S NEWNAME=$E(NAME_"                         ",1,27)
  1.  . I TYPE="INTWO" D
  1.  . . S SSN=$P(DATA,"^",2)
  1.  . . S DATA=$P(DATA,"^",1)
  1.  . . W !,NEWNAME_SSN_"  "_DATA
  1.  . . S RORTOTAL=RORTOTAL+1
  1.  . ;
  1.  . I TYPE="INTHREE" D
  1.  . . S SSN=$P(DATA,"^",4)
  1.  . . S DATE3=$P(DATA,"^",1),DATE3=$E(DATE3_"                  ",1,18)
  1.  . . S LOC3=$P(DATA,"^",2),LOC3=$E(LOC3_"                         ",1,25)
  1.  . . S LOC4=$P(DATA,"^",3)
  1.  . . W !,NEWNAME_SSN_" "_DATE3_LOC3_LOC4
  1.  . . S RORTOTAL=RORTOTAL+1
  1.  . ;
  1.  . I TYPE="INBOTH" D
  1.  . . S SSN=$P(DATA,"^",4)
  1.  . . S NEWNAME=$E(NEWNAME,1,25)
  1.  . . S BOTHDTE=$P(DATA,"^",1),BOTHDTE=$E(BOTHDTE_"                  ",1,15)
  1.  . . S BOTHLOC=$P(DATA,"^",2),BOTHLOC=$E(BOTHLOC_"                         ",1,22)
  1.  . . S DTE2=$P(DATA,"^",3)
  1.  . . W !,NEWNAME_SSN_" "_BOTHDTE_BOTHLOC_DTE2
  1.  . . S RORTOTAL=RORTOTAL+1
  1.  ;
  1.  I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE)  D HEDR
  1.  W !,"Total Patients: "_RORTOTAL
  1.  ;
  1.  D PRTC
  1.  Q
  1.  ;
  1.  ;
  1. LEGEND ;
  1.  D ENDHEAD
  1.  W !
  1.  W !," VA HIV 2.1 CONVERSION     Converted from ICR 2.1"
  1.  W !," VA HIV LAB                ICR Lab Results"
  1.  W !," VA HIV PROBLEM            ICR ICD-9 in the Problem List"
  1.  W !," VA HIV PTF                ICR ICD-9 in the Inpatient File (PTF)"
  1.  W !," VA HIV VPOV               ICR ICD-9 in the Outpatient File (V POV)"
  1.  D PRTC
  1.  Q
  1.  ;
  1. ICNERR ;
  1.  I '$D(^TMP("RORREP01",$J,"ICN")) Q
  1.  D ICNHEAD
  1.  N DFN,NAME,SSN
  1.  S NAME=""
  1.  F  S NAME=$O(^TMP("RORREP01",$J,"ICN",NAME)) Q:NAME=""  D
  1.  . S DFN=""
  1.  . F  S DFN=$O(^TMP("RORREP01",$J,"ICN",NAME,DFN)) Q:'DFN  D
  1.  . . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE)  D ICNHEAD
  1.  . . S SSN=^TMP("RORREP01",$J,"ICN",NAME,DFN)
  1.  . . W !," ",$E(NAME_"                           ",1,27)_SSN
  1.  Q
  1.  ;
  1. ISSUE ;
  1.  I '$D(^TMP("RORREP01",$J,"ISSUE","EVID")) Q
  1.  D EVID
  1.  N EIEN,NME S EIEN=0
  1.  F  S EIEN=$O(^TMP("RORREP01",$J,"ISSUE","EVID",EIEN)) Q:'EIEN  D 
  1.  . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE)  D EVID
  1.  . S NME=^TMP("RORREP01",$J,"ISSUE","EVID",EIEN)
  1.  . W !,NME
  1.  D PRTC
  1.  Q
  1.  ;
  1. ERROR ;
  1.  I '$D(^TMP("RORREP01",$J,"ERROR")) Q
  1.  D EHEAD
  1.  N CNT,EIEN,BUF,BUF1,BUFP  S EIEN=0
  1.  F  S EIEN=$O(^TMP("RORREP01",$J,"ERROR",EIEN)) Q:'EIEN  D
  1.  . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE)  D EHEAD
  1.  . S BUFP=^TMP("RORREP01",$J,"ERROR",EIEN)
  1.  . S BUF=$E(BUFP,1,78),BUF1=$E(BUFP,79,150)
  1.  . W BUF I BUF1'="" W "-"
  1.  . W !
  1.  . W BUF1,!
  1.  . I BUF1'="" W !
  1.  ;
  1.  F TMP="ROR","ENCODE"  D
  1.  . S CNT=0
  1.  . F  S CNT=$O(^TMP("RORREP01",$J,"ERROR",TMP,CNT)) Q:'CNT  D
  1.  . . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE)  D EHEAD
  1.  . . S BUFP=^TMP("RORREP01",$J,"ERROR",TMP,CNT)
  1.  . . S BUF=$E(BUFP,1,78),BUF1=$E(BUFP,79,150)
  1.  . . W BUF I BUF1'="" W "-"
  1.  . . W !
  1.  . . W BUF1,!
  1.  . . I BUF1'="" W !
  1.  D PRTC
  1.  Q
  1.  ;
  1.  ;
  1. PRTC ;press return to continue prompt
  1.  Q:$E(IOST,1,2)'="C-"!($D(IO("S")))
  1.  K DIR W ! S DIR(0)="E" D ^DIR K DIR I 'Y S IMRDONE=1
  1.  Q