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