- 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 Feb 18, 2025@23:09:15 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