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