PXRRFDP ;ISL/PKR - Final sort and print of frequency of diagnosis report. ;05/17/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,31,121,199,211**;Aug 12, 1996;Build 454
;
PRINT ;
N ANS,BD,BMARG,C1E,C1S,C2E,C2S,C3E,C3S,C1HS,C2HS,C3HS,CMAX,INDENT,MID
N DCSTR,HEAD,LEN,NUM,PAGE
N BYLOC,BYPC,BYPRV,DCIEN,DOCOUNT,DONE,DTOT,ED,ETOT,FOUND,HLOC,IC,ICD9IEN
N FACILITY,FACPNAME,IC,ICDDATA,ICDDATE,IMPDATE,INFOTYPE,LOCPNAM,NEWPAGE,PCLASS,PRV
N RATIO,STOIND,TEMP,TOTAL,TOTSTR,VACODE,ICDSTR
;
;Allow the task to be cleaned up upon successful completion.
S ZTREQ="@"
;
U IO
;ICR #5679
S IMPDATE=$$IMPDATE^LEXU("10D")
; When no Diagnoses found for Criteria for either ICD-9 or ICD-10, rpt Criteria
; and End the run.
I (DIAGTOT=0)&(DGTOT10=0) S DOCOUNT=1 D PROCSS2 G END
F DOCOUNT=1:1:2 D PROCESS
G END
;
PROCESS ;
I DOCOUNT=1,DIAGTOT=0 Q
I DOCOUNT=2,DGTOT10=0 Q
PROCSS2 S ICDDATE=$S(DOCOUNT=2:IMPDATE,1:$$FMADD^XLFDT(IMPDATE,-1))
S BMARG=2
S INDENT=3,PAGE=1,C1S=INDENT+29
;
S DONE=0
D HDR^PXRRGPRT(PAGE)
W !!,"Criteria for Frequency of Diagnoses Report"
W !,?INDENT,"Encounter diagnoses:",?C1S,$P(PXRRFDDC,U,2)
S BD=$$FMTE^XLFDT(PXRRBDT)
S ED=$$FMTE^XLFDT(PXRREDT)
W !,?INDENT,"Encounter date range:",?C1S,BD," through ",ED
I PXRRECAT="" D G MAXP
. W !,?INDENT,"Selected encounters:",?C1S,"ALL"
;
I $D(PXRRPRSC) W !,?INDENT,"Selected Providers:",?C1S,$P(PXRRPRSC,U,2)
I $D(PXRRCS) S ANS="YES"
E S ANS="ALL"
I $D(PXRRLCSC) W !,?INDENT,$P(PXRRLCSC,U,2)
I $D(PXRRETYP) W !,?INDENT,"Encounter type:",?C1S,PXRRETYP
;
I $D(PXRRDOB) D
. I (PXRRDOBE'=DT)&(PXRRDOBS'=0) D
.. W !,?INDENT,"Patient age range:",?C1S,PXRRMINA," to ",PXRRMAXA
.. S BD=$$FMTE^XLFDT(PXRRDOBS),ED=$$FMTE^XLFDT(PXRRDOBE)
.. W !,?INDENT,"Patient date of birth:",?C1S,BD," through ",ED
. I (PXRRDOBS=0) D
.. W !,?INDENT,"Patient age range:",?C1S,PXRRMINA," or more"
.. S ED=$$FMTE^XLFDT(PXRRDOBE)
.. W !,?INDENT,"Patient date of birth:",?C1S,ED," or before"
. I (PXRRDOBE=DT) D
.. W !,?INDENT,"Patient age range:",?C1S,"Up to ",PXRRMAXA
.. S BD=$$FMTE^XLFDT(PXRRDOBS),ED=$$FMTE^XLFDT(DT)
.. W !,?INDENT,"Patient date of birth:",?C1S,BD," through ",ED
E W !,?INDENT,"Patient age range:",?C1S,"ALL"
;
I $D(PXRRRACE) D
. N RACE
. S RACE="race"
. I NRACE>1 S RACE="races"
. W !?INDENT,"Patient ",RACE,":",?C1S,$P(PXRRRACE(1),U,2)
. F IC=2:1:NRACE W !,?C1S,$P(PXRRRACE(IC),U,2)
E W !?INDENT,"Patient race(s):",?C1S,"ALL"
;
I $D(PXRRSEX) W !?INDENT,"Patient sex:",?C1S,$P(PXRRSEX,U,2)
E W !?INDENT,"Patient sex:",?C1S,"BOTH"
;
I $D(PXRRSCAT) D OSCAT^PXRRGPRT(PXRRSCAT,INDENT)
;
I $P($G(PXRRPRSC),U,1)="C" D PECLASS^PXRRGPRT(INDENT)
;
MAXP W !!,?INDENT,"Maximum number of diagnoses to be displayed: ",PXRRDMAX
;
S CMAX=70
;
I $D(PXRRLCSC) D
. I PXRRLCSC["C" S PLOCNAM="Clinic Stop: "
. I PXRRLCSC["H" S PLOCNAM="Hospital Location: "
;
S FACILITY=""
NFAC S INFOTYPE="FACILITY"
S FACILITY=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY))
I +FACILITY=0 Q
;Mark the facility as being found.
F IC=1:1:NFAC I $P(PXRRFAC(IC),U,1)=FACILITY D Q
. S $P(PXRRFAC(IC),U,4)="M"
S FACPNAME=$P(PXRRFACN(FACILITY),U,1)_" "_$P(PXRRFACN(FACILITY),U,2)
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRFDD
;
NINFO S INFOTYPE=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE))
I INFOTYPE="" G NFAC
;
I INFOTYPE["LOC" S BYLOC=1
E S BYLOC=0
I INFOTYPE["PC" S BYPC=1
E S BYPC=0
I INFOTYPE["PRV" S BYPRV=1
E S BYPRV=0
;
S PRV=""
NPRV ;
S PRV=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV))
I PRV="" G NINFO
;
S VACODE=""
NVACODE ;
S VACODE=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE))
I VACODE="" G NPRV
;
S HLOC=""
NLOC S HLOC=$O(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE,HLOC))
I HLOC="" G NVACODE
;
S STOIND=^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE,HLOC)
;
;If the report is by provider get a person class for the provider.
I BYPRV D
. S TEMP=$P(PRV,U,4)
. I $L(TEMP)>0 S PCLASS=$$ABBRV^PXRRPECU(TEMP)
. E S PCLASS="Unknown"
;
;If the report is by person class get the person class.
I BYPC D
. S PCLASS=$$ABBRV^PXRRPECU(VACODE)
;
S HEAD=1
D HEAD(0)
I DONE G EXIT
S C1S=INDENT+60
I $Y>(IOSL-BMARG-4) D HEAD(1)
I DONE G EXIT
I $P(PXRRFDDC,U,1)="P" S TEMP="Total number of Primary Diagnoses for these Encounters:"
E S TEMP="Total number of Diagnoses for these Encounters:"
I $D(^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)) S ETOT=^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)
E S ETOT=0
S TOTSTR=$S(DOCOUNT=1:"DIAGTOT",1:"DGTOT10")
I $D(^XTMP(PXRRXTMP,"TOTALS",TOTSTR,STOIND)) S DTOT=^XTMP(PXRRXTMP,"TOTALS",TOTSTR,STOIND)
E S DTOT=0
S LEN=$$MAX^XLFMTH($L(DTOT),$L(ETOT))
W !!,?INDENT,"Total number of Encounters meeting the selection criteria:",?C1S,$J(ETOT,LEN)
W !,?INDENT,TEMP,?C1S,$J(DTOT,LEN)
S RATIO=$S(ETOT>0:(DTOT/ETOT),1:0)
W !,?INDENT,"Diagnoses/Encounter ratio:",?C1S,$J(RATIO,LEN,2)
;
S C1S=INDENT+8,C2E=INDENT+59
S C1HS=INDENT+9,C2HS=INDENT+33
S TOTAL=""
S NUM=0,ICDSTR=$S(DOCOUNT=1:"ICD9",1:"ICD10")
NTOTICD S TOTAL=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,ICDSTR,TOTAL),-1)
I TOTAL="" G DIAGCAT
S TEMP=TOTAL
S ICD9IEN=""
NICD9 S ICD9IEN=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,ICDSTR,TOTAL,ICD9IEN),-1)
I ICD9IEN="" G NTOTICD
S NUM=NUM+1
I NUM=1 S HEAD=1
I $Y>(IOSL-BMARG-5) S NEWPAGE=1
E S NEWPAGE=0
D DHEAD(NEWPAGE)
I DONE G EXIT
S C3S=C3E-$L(TEMP)
S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",ICD9IEN,ICDDATE,"I")
W !," ",$P(ICDDATA,U,2),?11,$E($P(ICDDATA,U,4),1,60),?72,$J($FN(TEMP,",",0),7)
I NUM<PXRRDMAX G NICD9
DIAGCAT ;
S C1S=INDENT+8,C1E=INDENT+38
S C1HS=14
S TOTAL=""
S NUM=0
S DCSTR=$S(DOCOUNT=1:"DC",1:"DC10")
NTOTDC S TOTAL=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,DCSTR,TOTAL),-1)
I TOTAL="" G NLOC
S TEMP=TOTAL
S DCIEN=""
NDC S DCIEN=$O(^XTMP(PXRRXTMP,"PRINT",STOIND,DCSTR,TOTAL,DCIEN),-1)
I DCIEN="" G NTOTDC
S NUM=NUM+1
I NUM=1 S HEAD=1
I $Y>(IOSL-BMARG-5) S NEWPAGE=1
E S NEWPAGE=0
D DCHEAD(NEWPAGE)
I DONE G EXIT
S C2S=C2E-$L(TEMP)
;We will need a DBIA to read ICM. Some sites have had a corrupted ICM
;file. Check for this problem, if found print an error message and
;quit.
I (DCIEN>0)&('$D(^ICM(DCIEN,0))) D G EXIT
. W !!,"CANNOT CONTINUE, File 80.3 Major Diagnostic Category is corrupted!"
. W !,"^ICM(",DCIEN,",0) is missing."
. W !,"Please contact customer service for help."
I DCIEN>0 W !,?INDENT,$J(NUM,5),".",?C1S,$P(^ICM(DCIEN,0),U,1),?C2S,TEMP
E W !,?INDENT,$J(NUM,5),".",?C1S,"Unknown",?C2S,TEMP
I NUM<PXRRDMAX G NDC
;
;Get the next location.
G NLOC
END ;
;Check for facilities that were listed but had no encounters.
D FACNE^PXRRGPRT(INDENT)
EXIT ;
D EXIT^PXRRGUT
D EOR^PXRRGUT
Q
;
;=======================================================================
DHEAD(NEWPAGE) ;
N DASH60 S $P(DASH60,"-",61)=""
I NEWPAGE D PAGE^PXRRGPRT
E I $Y>(IOSL-BMARG) D PAGE^PXRRGPRT
I DONE Q
I (HEAD)&(RATIO>0) D
. S LEN=$$MAX^XLFMTH(9,$L(TEMP))
. S MID=C2E+3+(LEN/2)
. S C3HS=MID-5
. S C3E=MID+($L(TEMP)/2)
. W !!,?INDENT,PXRRDMAX," Most Frequent ICD-",$S(DOCOUNT=1:"9",1:"10")," Diagnoses:"
. W !," Code",?11,"Description",?72,"Freq."
. W !," --------",?11,DASH60,?72,"-------"
. S HEAD=0
Q
;
;=======================================================================
DCHEAD(NEWPAGE) ;
I NEWPAGE D PAGE^PXRRGPRT
E I $Y>(IOSL-BMARG) D PAGE^PXRRGPRT
I DONE Q
I (HEAD)&(RATIO>0) D
. S LEN=$$MAX^XLFMTH(9,$L(TEMP))
. S MID=C1E+3+(LEN/2)
. S C2HS=MID-5
. S C2E=MID+($L(TEMP)/2)
. W !!,?INDENT,PXRRDMAX," Most Frequent ICD-",$S(DOCOUNT=1:"9",1:"10")," Diagnostic Categories:"
. W !,?C1HS,"Diagnostic Category",?C2HS,"Frequency"
. W !,?C1S,"------------------------------",?C2HS,"---------"
. S HEAD=0
Q
;
;=======================================================================
HEAD(NEWPAGE) ;
N LEN,TEMP
I NEWPAGE D PAGE^PXRRGPRT
E I $Y>(IOSL-BMARG-8) D PAGE^PXRRGPRT
I DONE Q
I HEAD D
. W !!,"___________________________________________________________________"
. W !,"Facility: ",FACPNAME
. I BYLOC W !,PLOCNAM,$P(HLOC,U,1)_" (",$P(HLOC,U,3)_")"
. I BYPRV D
.. S TEMP="Provider: "_$P(PRV,U,1)_" ("_PCLASS_")"
.. S LEN=$L(TEMP)
.. I LEN>CMAX D
... W !,$E(TEMP,1,CMAX)
... W !," ",$E(TEMP,CMAX+1,LEN)
.. E W !,TEMP
. I BYPC D
.. W !,"Person Class (Occupation+Specialty+Subspecialty): "
.. S LEN=INDENT+$L(PCLASS)
.. I LEN>CMAX D
... W !,?INDENT,$E(PCLASS,1,CMAX)
... W !,?(INDENT+1),$E(PCLASS,CMAX+1,LEN)
.. E W !,?INDENT,PCLASS
. S HEAD=0
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRFDP 8741 printed Sep 02, 2024@19:15:59 Page 2
PXRRFDP ;ISL/PKR - Final sort and print of frequency of diagnosis report. ;05/17/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,31,121,199,211**;Aug 12, 1996;Build 454
+2 ;
PRINT ;
+1 NEW ANS,BD,BMARG,C1E,C1S,C2E,C2S,C3E,C3S,C1HS,C2HS,C3HS,CMAX,INDENT,MID
+2 NEW DCSTR,HEAD,LEN,NUM,PAGE
+3 NEW BYLOC,BYPC,BYPRV,DCIEN,DOCOUNT,DONE,DTOT,ED,ETOT,FOUND,HLOC,IC,ICD9IEN
+4 NEW FACILITY,FACPNAME,IC,ICDDATA,ICDDATE,IMPDATE,INFOTYPE,LOCPNAM,NEWPAGE,PCLASS,PRV
+5 NEW RATIO,STOIND,TEMP,TOTAL,TOTSTR,VACODE,ICDSTR
+6 ;
+7 ;Allow the task to be cleaned up upon successful completion.
+8 SET ZTREQ="@"
+9 ;
+10 USE IO
+11 ;ICR #5679
+12 SET IMPDATE=$$IMPDATE^LEXU("10D")
+13 ; When no Diagnoses found for Criteria for either ICD-9 or ICD-10, rpt Criteria
+14 ; and End the run.
+15 IF (DIAGTOT=0)&(DGTOT10=0)
SET DOCOUNT=1
DO PROCSS2
GOTO END
+16 FOR DOCOUNT=1:1:2
DO PROCESS
+17 GOTO END
+18 ;
PROCESS ;
+1 IF DOCOUNT=1
IF DIAGTOT=0
QUIT
+2 IF DOCOUNT=2
IF DGTOT10=0
QUIT
PROCSS2 SET ICDDATE=$SELECT(DOCOUNT=2:IMPDATE,1:$$FMADD^XLFDT(IMPDATE,-1))
+1 SET BMARG=2
+2 SET INDENT=3
SET PAGE=1
SET C1S=INDENT+29
+3 ;
+4 SET DONE=0
+5 DO HDR^PXRRGPRT(PAGE)
+6 WRITE !!,"Criteria for Frequency of Diagnoses Report"
+7 WRITE !,?INDENT,"Encounter diagnoses:",?C1S,$PIECE(PXRRFDDC,U,2)
+8 SET BD=$$FMTE^XLFDT(PXRRBDT)
+9 SET ED=$$FMTE^XLFDT(PXRREDT)
+10 WRITE !,?INDENT,"Encounter date range:",?C1S,BD," through ",ED
+11 IF PXRRECAT=""
Begin DoDot:1
+12 WRITE !,?INDENT,"Selected encounters:",?C1S,"ALL"
End DoDot:1
GOTO MAXP
+13 ;
+14 IF $DATA(PXRRPRSC)
WRITE !,?INDENT,"Selected Providers:",?C1S,$PIECE(PXRRPRSC,U,2)
+15 IF $DATA(PXRRCS)
SET ANS="YES"
+16 IF '$TEST
SET ANS="ALL"
+17 IF $DATA(PXRRLCSC)
WRITE !,?INDENT,$PIECE(PXRRLCSC,U,2)
+18 IF $DATA(PXRRETYP)
WRITE !,?INDENT,"Encounter type:",?C1S,PXRRETYP
+19 ;
+20 IF $DATA(PXRRDOB)
Begin DoDot:1
+21 IF (PXRRDOBE'=DT)&(PXRRDOBS'=0)
Begin DoDot:2
+22 WRITE !,?INDENT,"Patient age range:",?C1S,PXRRMINA," to ",PXRRMAXA
+23 SET BD=$$FMTE^XLFDT(PXRRDOBS)
SET ED=$$FMTE^XLFDT(PXRRDOBE)
+24 WRITE !,?INDENT,"Patient date of birth:",?C1S,BD," through ",ED
End DoDot:2
+25 IF (PXRRDOBS=0)
Begin DoDot:2
+26 WRITE !,?INDENT,"Patient age range:",?C1S,PXRRMINA," or more"
+27 SET ED=$$FMTE^XLFDT(PXRRDOBE)
+28 WRITE !,?INDENT,"Patient date of birth:",?C1S,ED," or before"
End DoDot:2
+29 IF (PXRRDOBE=DT)
Begin DoDot:2
+30 WRITE !,?INDENT,"Patient age range:",?C1S,"Up to ",PXRRMAXA
+31 SET BD=$$FMTE^XLFDT(PXRRDOBS)
SET ED=$$FMTE^XLFDT(DT)
+32 WRITE !,?INDENT,"Patient date of birth:",?C1S,BD," through ",ED
End DoDot:2
End DoDot:1
+33 IF '$TEST
WRITE !,?INDENT,"Patient age range:",?C1S,"ALL"
+34 ;
+35 IF $DATA(PXRRRACE)
Begin DoDot:1
+36 NEW RACE
+37 SET RACE="race"
+38 IF NRACE>1
SET RACE="races"
+39 WRITE !?INDENT,"Patient ",RACE,":",?C1S,$PIECE(PXRRRACE(1),U,2)
+40 FOR IC=2:1:NRACE
WRITE !,?C1S,$PIECE(PXRRRACE(IC),U,2)
End DoDot:1
+41 IF '$TEST
WRITE !?INDENT,"Patient race(s):",?C1S,"ALL"
+42 ;
+43 IF $DATA(PXRRSEX)
WRITE !?INDENT,"Patient sex:",?C1S,$PIECE(PXRRSEX,U,2)
+44 IF '$TEST
WRITE !?INDENT,"Patient sex:",?C1S,"BOTH"
+45 ;
+46 IF $DATA(PXRRSCAT)
DO OSCAT^PXRRGPRT(PXRRSCAT,INDENT)
+47 ;
+48 IF $PIECE($GET(PXRRPRSC),U,1)="C"
DO PECLASS^PXRRGPRT(INDENT)
+49 ;
MAXP WRITE !!,?INDENT,"Maximum number of diagnoses to be displayed: ",PXRRDMAX
+1 ;
+2 SET CMAX=70
+3 ;
+4 IF $DATA(PXRRLCSC)
Begin DoDot:1
+5 IF PXRRLCSC["C"
SET PLOCNAM="Clinic Stop: "
+6 IF PXRRLCSC["H"
SET PLOCNAM="Hospital Location: "
End DoDot:1
+7 ;
+8 SET FACILITY=""
NFAC SET INFOTYPE="FACILITY"
+1 SET FACILITY=$ORDER(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY))
+2 IF +FACILITY=0
QUIT
+3 ;Mark the facility as being found.
+4 FOR IC=1:1:NFAC
IF $PIECE(PXRRFAC(IC),U,1)=FACILITY
Begin DoDot:1
+5 SET $PIECE(PXRRFAC(IC),U,4)="M"
End DoDot:1
QUIT
+6 SET FACPNAME=$PIECE(PXRRFACN(FACILITY),U,1)_" "_$PIECE(PXRRFACN(FACILITY),U,2)
+7 ;
+8 ;Check for a user request to stop the task.
+9 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRFDD
+10 ;
NINFO SET INFOTYPE=$ORDER(^XTMP(PXRRXTMP,"INFO",INFOTYPE))
+1 IF INFOTYPE=""
GOTO NFAC
+2 ;
+3 IF INFOTYPE["LOC"
SET BYLOC=1
+4 IF '$TEST
SET BYLOC=0
+5 IF INFOTYPE["PC"
SET BYPC=1
+6 IF '$TEST
SET BYPC=0
+7 IF INFOTYPE["PRV"
SET BYPRV=1
+8 IF '$TEST
SET BYPRV=0
+9 ;
+10 SET PRV=""
NPRV ;
+1 SET PRV=$ORDER(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV))
+2 IF PRV=""
GOTO NINFO
+3 ;
+4 SET VACODE=""
NVACODE ;
+1 SET VACODE=$ORDER(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE))
+2 IF VACODE=""
GOTO NPRV
+3 ;
+4 SET HLOC=""
NLOC SET HLOC=$ORDER(^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE,HLOC))
+1 IF HLOC=""
GOTO NVACODE
+2 ;
+3 SET STOIND=^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PRV,VACODE,HLOC)
+4 ;
+5 ;If the report is by provider get a person class for the provider.
+6 IF BYPRV
Begin DoDot:1
+7 SET TEMP=$PIECE(PRV,U,4)
+8 IF $LENGTH(TEMP)>0
SET PCLASS=$$ABBRV^PXRRPECU(TEMP)
+9 IF '$TEST
SET PCLASS="Unknown"
End DoDot:1
+10 ;
+11 ;If the report is by person class get the person class.
+12 IF BYPC
Begin DoDot:1
+13 SET PCLASS=$$ABBRV^PXRRPECU(VACODE)
End DoDot:1
+14 ;
+15 SET HEAD=1
+16 DO HEAD(0)
+17 IF DONE
GOTO EXIT
+18 SET C1S=INDENT+60
+19 IF $Y>(IOSL-BMARG-4)
DO HEAD(1)
+20 IF DONE
GOTO EXIT
+21 IF $PIECE(PXRRFDDC,U,1)="P"
SET TEMP="Total number of Primary Diagnoses for these Encounters:"
+22 IF '$TEST
SET TEMP="Total number of Diagnoses for these Encounters:"
+23 IF $DATA(^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND))
SET ETOT=^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)
+24 IF '$TEST
SET ETOT=0
+25 SET TOTSTR=$SELECT(DOCOUNT=1:"DIAGTOT",1:"DGTOT10")
+26 IF $DATA(^XTMP(PXRRXTMP,"TOTALS",TOTSTR,STOIND))
SET DTOT=^XTMP(PXRRXTMP,"TOTALS",TOTSTR,STOIND)
+27 IF '$TEST
SET DTOT=0
+28 SET LEN=$$MAX^XLFMTH($LENGTH(DTOT),$LENGTH(ETOT))
+29 WRITE !!,?INDENT,"Total number of Encounters meeting the selection criteria:",?C1S,$JUSTIFY(ETOT,LEN)
+30 WRITE !,?INDENT,TEMP,?C1S,$JUSTIFY(DTOT,LEN)
+31 SET RATIO=$SELECT(ETOT>0:(DTOT/ETOT),1:0)
+32 WRITE !,?INDENT,"Diagnoses/Encounter ratio:",?C1S,$JUSTIFY(RATIO,LEN,2)
+33 ;
+34 SET C1S=INDENT+8
SET C2E=INDENT+59
+35 SET C1HS=INDENT+9
SET C2HS=INDENT+33
+36 SET TOTAL=""
+37 SET NUM=0
SET ICDSTR=$SELECT(DOCOUNT=1:"ICD9",1:"ICD10")
NTOTICD SET TOTAL=$ORDER(^XTMP(PXRRXTMP,"PRINT",STOIND,ICDSTR,TOTAL),-1)
+1 IF TOTAL=""
GOTO DIAGCAT
+2 SET TEMP=TOTAL
+3 SET ICD9IEN=""
NICD9 SET ICD9IEN=$ORDER(^XTMP(PXRRXTMP,"PRINT",STOIND,ICDSTR,TOTAL,ICD9IEN),-1)
+1 IF ICD9IEN=""
GOTO NTOTICD
+2 SET NUM=NUM+1
+3 IF NUM=1
SET HEAD=1
+4 IF $Y>(IOSL-BMARG-5)
SET NEWPAGE=1
+5 IF '$TEST
SET NEWPAGE=0
+6 DO DHEAD(NEWPAGE)
+7 IF DONE
GOTO EXIT
+8 SET C3S=C3E-$LENGTH(TEMP)
+9 SET ICDDATA=$$ICDDATA^ICDXCODE("DIAG",ICD9IEN,ICDDATE,"I")
+10 WRITE !," ",$PIECE(ICDDATA,U,2),?11,$EXTRACT($PIECE(ICDDATA,U,4),1,60),?72,$JUSTIFY($FNUMBER(TEMP,",",0),7)
+11 IF NUM<PXRRDMAX
GOTO NICD9
DIAGCAT ;
+1 SET C1S=INDENT+8
SET C1E=INDENT+38
+2 SET C1HS=14
+3 SET TOTAL=""
+4 SET NUM=0
+5 SET DCSTR=$SELECT(DOCOUNT=1:"DC",1:"DC10")
NTOTDC SET TOTAL=$ORDER(^XTMP(PXRRXTMP,"PRINT",STOIND,DCSTR,TOTAL),-1)
+1 IF TOTAL=""
GOTO NLOC
+2 SET TEMP=TOTAL
+3 SET DCIEN=""
NDC SET DCIEN=$ORDER(^XTMP(PXRRXTMP,"PRINT",STOIND,DCSTR,TOTAL,DCIEN),-1)
+1 IF DCIEN=""
GOTO NTOTDC
+2 SET NUM=NUM+1
+3 IF NUM=1
SET HEAD=1
+4 IF $Y>(IOSL-BMARG-5)
SET NEWPAGE=1
+5 IF '$TEST
SET NEWPAGE=0
+6 DO DCHEAD(NEWPAGE)
+7 IF DONE
GOTO EXIT
+8 SET C2S=C2E-$LENGTH(TEMP)
+9 ;We will need a DBIA to read ICM. Some sites have had a corrupted ICM
+10 ;file. Check for this problem, if found print an error message and
+11 ;quit.
+12 IF (DCIEN>0)&('$DATA(^ICM(DCIEN,0)))
Begin DoDot:1
+13 WRITE !!,"CANNOT CONTINUE, File 80.3 Major Diagnostic Category is corrupted!"
+14 WRITE !,"^ICM(",DCIEN,",0) is missing."
+15 WRITE !,"Please contact customer service for help."
End DoDot:1
GOTO EXIT
+16 IF DCIEN>0
WRITE !,?INDENT,$JUSTIFY(NUM,5),".",?C1S,$PIECE(^ICM(DCIEN,0),U,1),?C2S,TEMP
+17 IF '$TEST
WRITE !,?INDENT,$JUSTIFY(NUM,5),".",?C1S,"Unknown",?C2S,TEMP
+18 IF NUM<PXRRDMAX
GOTO NDC
+19 ;
+20 ;Get the next location.
+21 GOTO NLOC
END ;
+1 ;Check for facilities that were listed but had no encounters.
+2 DO FACNE^PXRRGPRT(INDENT)
EXIT ;
+1 DO EXIT^PXRRGUT
+2 DO EOR^PXRRGUT
+3 QUIT
+4 ;
+5 ;=======================================================================
DHEAD(NEWPAGE) ;
+1 NEW DASH60
SET $PIECE(DASH60,"-",61)=""
+2 IF NEWPAGE
DO PAGE^PXRRGPRT
+3 IF '$TEST
IF $Y>(IOSL-BMARG)
DO PAGE^PXRRGPRT
+4 IF DONE
QUIT
+5 IF (HEAD)&(RATIO>0)
Begin DoDot:1
+6 SET LEN=$$MAX^XLFMTH(9,$LENGTH(TEMP))
+7 SET MID=C2E+3+(LEN/2)
+8 SET C3HS=MID-5
+9 SET C3E=MID+($LENGTH(TEMP)/2)
+10 WRITE !!,?INDENT,PXRRDMAX," Most Frequent ICD-",$SELECT(DOCOUNT=1:"9",1:"10")," Diagnoses:"
+11 WRITE !," Code",?11,"Description",?72,"Freq."
+12 WRITE !," --------",?11,DASH60,?72,"-------"
+13 SET HEAD=0
End DoDot:1
+14 QUIT
+15 ;
+16 ;=======================================================================
DCHEAD(NEWPAGE) ;
+1 IF NEWPAGE
DO PAGE^PXRRGPRT
+2 IF '$TEST
IF $Y>(IOSL-BMARG)
DO PAGE^PXRRGPRT
+3 IF DONE
QUIT
+4 IF (HEAD)&(RATIO>0)
Begin DoDot:1
+5 SET LEN=$$MAX^XLFMTH(9,$LENGTH(TEMP))
+6 SET MID=C1E+3+(LEN/2)
+7 SET C2HS=MID-5
+8 SET C2E=MID+($LENGTH(TEMP)/2)
+9 WRITE !!,?INDENT,PXRRDMAX," Most Frequent ICD-",$SELECT(DOCOUNT=1:"9",1:"10")," Diagnostic Categories:"
+10 WRITE !,?C1HS,"Diagnostic Category",?C2HS,"Frequency"
+11 WRITE !,?C1S,"------------------------------",?C2HS,"---------"
+12 SET HEAD=0
End DoDot:1
+13 QUIT
+14 ;
+15 ;=======================================================================
HEAD(NEWPAGE) ;
+1 NEW LEN,TEMP
+2 IF NEWPAGE
DO PAGE^PXRRGPRT
+3 IF '$TEST
IF $Y>(IOSL-BMARG-8)
DO PAGE^PXRRGPRT
+4 IF DONE
QUIT
+5 IF HEAD
Begin DoDot:1
+6 WRITE !!,"___________________________________________________________________"
+7 WRITE !,"Facility: ",FACPNAME
+8 IF BYLOC
WRITE !,PLOCNAM,$PIECE(HLOC,U,1)_" (",$PIECE(HLOC,U,3)_")"
+9 IF BYPRV
Begin DoDot:2
+10 SET TEMP="Provider: "_$PIECE(PRV,U,1)_" ("_PCLASS_")"
+11 SET LEN=$LENGTH(TEMP)
+12 IF LEN>CMAX
Begin DoDot:3
+13 WRITE !,$EXTRACT(TEMP,1,CMAX)
+14 WRITE !," ",$EXTRACT(TEMP,CMAX+1,LEN)
End DoDot:3
+15 IF '$TEST
WRITE !,TEMP
End DoDot:2
+16 IF BYPC
Begin DoDot:2
+17 WRITE !,"Person Class (Occupation+Specialty+Subspecialty): "
+18 SET LEN=INDENT+$LENGTH(PCLASS)
+19 IF LEN>CMAX
Begin DoDot:3
+20 WRITE !,?INDENT,$EXTRACT(PCLASS,1,CMAX)
+21 WRITE !,?(INDENT+1),$EXTRACT(PCLASS,CMAX+1,LEN)
End DoDot:3
+22 IF '$TEST
WRITE !,?INDENT,PCLASS
End DoDot:2
+23 SET HEAD=0
End DoDot:1
+24 QUIT
+25 ;