IBDFOSG3 ;ALB/MAF/AAS - NUMBER OF ENCOUNTERS WITH CPT'S AND DX'S REPORT ;3/18/96
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
% I '$D(DT) D DT^DICRW
D END
W !!,"Number of Encounters with CPT, Diagnosis"
S VAUTD=1 I $D(^DG(43,1,"GL")) D DIVISION^VAUTOMA G:Y=-1 END
S IBDFDAT=$$HTE^XLFDT($H)
;
DATE ; -- select date
S (IBBDT,IBDFBEG)=2940401,(IBEDT,IBDFEND)=2960331
;
DEV ; -- select device, run option
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="DQ^IBDFOSG3",ZTSAVE("IB*")="",ZTSAVE("VA*")="",ZTDESC="IBD - Number of Encounters with Stop Codes, CPT, Diagnosis" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
;
U IO
S X=132 X ^%ZOSF("RM")
DQ D PRINT G END
Q
;
END ; -- Clean up
K ^TMP("MNTH",$J),^TMP("DTOT",$J),^TMP("GTOT",$J) W !
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K IBBDT,IBCS,IBDDT,IBDDT1,IBDFMN,IBDFMN1,IBDFMNI,IBDFN,IBDIV,IBDIVNM,IBI,IBIFN,IBJ,IBMNTH,IBNODE,IBPARNT,IBPIECE,IBPR,IBPROC,IBSTOP,POP,SDCNT,U
K IBDFBEG,IBDFDAT,IBDFDIV,IBDFDVE,IBDFEND,IBEDT,IBFLG4,IBHDT,IBQUIT,IBTSBDT,IBTSEDT,SDDXY,X,Y,IBCLIN,IBPAG,VAUTD
Q
;K X,Y,DFN,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT,IBDFDVE
;K IBCNT,IBDFBEG,IBDFCLI,IBDFDA,IBDFDAT,IBDFDIV,IBDFEND,IBDFIFN,IBDFNODE,IBDFNUM,IBDFSA,IBDFT,IBDFTMP,IBDFTMP1,IBDFTMP2,IBDFTPRT
;K IBFLG1,IBFLG2,IBFLG3,IBFLG4,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9,IBMCNODE,IBMCSND,IBNAM,IBTSBDT,IBTSEDT
;K VAUTC,VAUTD
Q
;
PRINT ; -- print report
; Data sorted into ^tmp arrays
;
; Monthly Totals := ^tmp("mnth",$j,division,year/month)=
; Division Totals := ^tmp("dtot",$j,division) =
; Grand Totals := ^tmp("gtot",$j) =
;
S (IBPAG,IBDFDVE)=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
S IBTSBDT=IBBDT-.1,IBTSEDT=IBEDT+.9
D QUIT
D START^IBDFOSG4
;
PR ;
I '$D(^TMP("MNTH",$J)) D HDR W !!,"No Data Meeting This Criteria for the Date Range Chosen",! Q
N IBDFDV,IBDFCL,IBDNODE,IBDFTMP,IBDFPAT,IBDFPT,IBDFT
S (IBDFDV,IBDFCL,IBDFPT)=0
F IBDFDIV=0:0 S IBDFDV=$O(^TMP("MNTH",$J,IBDFDV)) Q:IBDFDV']""!(IBQUIT) D HDR Q:IBQUIT D
.D DIVH
.S IBDFMN=0
.F IBDFMNI=0:0 S IBDFMN=$O(^TMP("MNTH",$J,IBDFDV,IBDFMN)) Q:IBDFMN="" D ONEMN I $O(^TMP("MNTH",$J,IBDFDV,IBDFMN))="" S IBDFDVE=1 D ONEDV
;
; -- Print Totals Page
S IBDFDVE=0
Q:IBQUIT
D HDR
S (IBDFDV,IBDFCL,IBDFPT)=0
S IBFLG4=1 ;1 := on division totals page
F IBDFDIV=0:0 S IBDFDV=$O(^TMP("DTOT",$J,IBDFDV)) Q:IBDFDV']""!(IBQUIT) D ONEDV
Q:IBQUIT
D DASH
D LINE("GRAND TOTAL",^TMP("GTOT",$J))
Q
;
ONEMN ; -- Print one months data
Q:IBQUIT
N IBDFNM1
Q:'$D(^TMP("MNTH",$J,IBDFDV,IBDFMN))!(^TMP("MNTH",$J,IBDFDV,IBDFMN)="0^0^0")
S Y=IBDFMN D DD^%DT S IBDFMN1=Y
D LINE(IBDFMN1,^TMP("MNTH",$J,IBDFDV,IBDFMN))
Q
;
ONEDV ; -- Print Division totals
Q:IBQUIT
I IOSL<($Y+5) D HDR Q:IBQUIT
Q:^TMP("DTOT",$J,IBDFDV)="0^0^0"&('$D(IBFLG4))
I IBDFDVE=1 D DASH S IBDFDVE=0
D LINE($E(IBDFDV,1,25)_" ("_$P($$SITE^VASITE(,$O(^DG(40.8,"B",IBDFDV,0))),"^",3)_")",^TMP("DTOT",$J,IBDFDV))
Q
;
LINE(NAME,IBX) ;
; -- print detail line
; input Name := text to be printed
; ibx ;= 3 piece global node containing data
;
I IOSL<($Y+5) D HDR Q:IBQUIT
W !,$E(NAME,1,35)
W ?39,$J($P(IBX,"^",2),8)
W ?57,$J($P(IBX,"^",3),8)
Q
;
HDR ; -- Print header for report
Q:IBQUIT
I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"# Encounters / CPT's, Dx",?(IOM-33),"Page ",IBPAG," ",IBHDT
W !,"For Period beginning on ",$$FMTE^XLFDT(IBBDT,2)," to ",$$FMTE^XLFDT(IBEDT,2)
W !,?44,"CPT",?56,"Diagnosis"
W !,$TR($J(" ",IOM)," ","-")
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stopped at user request" Q
Q
;
;
QUIT K ^TMP("MNTH",$J),^TMP("DTOT",$J),^TMP("GTOT",$J) W !
Q
;
;
DASH W !,"------------------",?39,"--------",?57,"--------"
Q
;
DIVH ; -- Write division header
I IOSL<($Y+5) D HDR Q:IBQUIT
Q:^TMP("DTOT",$J,IBDFDV)="0^0^0"
W !!,?(IOM-$L(IBDFDV)+10/2),"DIVISION: ",IBDFDV_" ("_$P($$SITE^VASITE(,$O(^DG(40.8,"B",IBDFDV,0))),"^",3)_")",!
Q
IBDFOSG3 ;ALB/MAF/AAS - NUMBER OF ENCOUNTERS WITH CPT'S AND DX'S REPORT ;3/18/96
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
+1 DO END
+2 WRITE !!,"Number of Encounters with CPT, Diagnosis"
+3 SET VAUTD=1
IF $DATA(^DG(43,1,"GL"))
DO DIVISION^VAUTOMA
IF Y=-1
GOTO END
+4 SET IBDFDAT=$$HTE^XLFDT($HOROLOG)
+5 ;
DATE ; -- select date
+1 SET (IBBDT,IBDFBEG)=2940401
SET (IBEDT,IBDFEND)=2960331
+2 ;
DEV ; -- select device, run option
+1 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO END
+2 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBDFOSG3"
SET ZTSAVE("IB*")=""
SET ZTSAVE("VA*")=""
SET ZTDESC="IBD - Number of Encounters with Stop Codes, CPT, Diagnosis"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO END
+3 ;
+4 USE IO
+5 SET X=132
XECUTE ^%ZOSF("RM")
DQ DO PRINT
GOTO END
+1 QUIT
+2 ;
END ; -- Clean up
+1 KILL ^TMP("MNTH",$JOB),^TMP("DTOT",$JOB),^TMP("GTOT",$JOB)
WRITE !
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL IBBDT,IBCS,IBDDT,IBDDT1,IBDFMN,IBDFMN1,IBDFMNI,IBDFN,IBDIV,IBDIVNM,IBI,IBIFN,IBJ,IBMNTH,IBNODE,IBPARNT,IBPIECE,IBPR,IBPROC,IBSTOP,POP,SDCNT,U
+5 KILL IBDFBEG,IBDFDAT,IBDFDIV,IBDFDVE,IBDFEND,IBEDT,IBFLG4,IBHDT,IBQUIT,IBTSBDT,IBTSEDT,SDDXY,X,Y,IBCLIN,IBPAG,VAUTD
+6 QUIT
+7 ;K X,Y,DFN,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT,IBDFDVE
+8 ;K IBCNT,IBDFBEG,IBDFCLI,IBDFDA,IBDFDAT,IBDFDIV,IBDFEND,IBDFIFN,IBDFNODE,IBDFNUM,IBDFSA,IBDFT,IBDFTMP,IBDFTMP1,IBDFTMP2,IBDFTPRT
+9 ;K IBFLG1,IBFLG2,IBFLG3,IBFLG4,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9,IBMCNODE,IBMCSND,IBNAM,IBTSBDT,IBTSEDT
+10 ;K VAUTC,VAUTD
+11 QUIT
+12 ;
PRINT ; -- print report
+1 ; Data sorted into ^tmp arrays
+2 ;
+3 ; Monthly Totals := ^tmp("mnth",$j,division,year/month)=
+4 ; Division Totals := ^tmp("dtot",$j,division) =
+5 ; Grand Totals := ^tmp("gtot",$j) =
+6 ;
+7 SET (IBPAG,IBDFDVE)=0
SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
SET IBQUIT=0
+8 SET IBTSBDT=IBBDT-.1
SET IBTSEDT=IBEDT+.9
+9 DO QUIT
+10 DO START^IBDFOSG4
+11 ;
PR ;
+1 IF '$DATA(^TMP("MNTH",$JOB))
DO HDR
WRITE !!,"No Data Meeting This Criteria for the Date Range Chosen",!
QUIT
+2 NEW IBDFDV,IBDFCL,IBDNODE,IBDFTMP,IBDFPAT,IBDFPT,IBDFT
+3 SET (IBDFDV,IBDFCL,IBDFPT)=0
+4 FOR IBDFDIV=0:0
SET IBDFDV=$ORDER(^TMP("MNTH",$JOB,IBDFDV))
IF IBDFDV']""!(IBQUIT)
QUIT
DO HDR
IF IBQUIT
QUIT
Begin DoDot:1
+5 DO DIVH
+6 SET IBDFMN=0
+7 FOR IBDFMNI=0:0
SET IBDFMN=$ORDER(^TMP("MNTH",$JOB,IBDFDV,IBDFMN))
IF IBDFMN=""
QUIT
DO ONEMN
IF $ORDER(^TMP("MNTH",$JOB,IBDFDV,IBDFMN))=""
SET IBDFDVE=1
DO ONEDV
End DoDot:1
+8 ;
+9 ; -- Print Totals Page
+10 SET IBDFDVE=0
+11 IF IBQUIT
QUIT
+12 DO HDR
+13 SET (IBDFDV,IBDFCL,IBDFPT)=0
+14 ;1 := on division totals page
SET IBFLG4=1
+15 FOR IBDFDIV=0:0
SET IBDFDV=$ORDER(^TMP("DTOT",$JOB,IBDFDV))
IF IBDFDV']""!(IBQUIT)
QUIT
DO ONEDV
+16 IF IBQUIT
QUIT
+17 DO DASH
+18 DO LINE("GRAND TOTAL",^TMP("GTOT",$JOB))
+19 QUIT
+20 ;
ONEMN ; -- Print one months data
+1 IF IBQUIT
QUIT
+2 NEW IBDFNM1
+3 IF '$DATA(^TMP("MNTH",$JOB,IBDFDV,IBDFMN))!(^TMP("MNTH",$JOB,IBDFDV,IBDFMN)="0^0^0")
QUIT
+4 SET Y=IBDFMN
DO DD^%DT
SET IBDFMN1=Y
+5 DO LINE(IBDFMN1,^TMP("MNTH",$JOB,IBDFDV,IBDFMN))
+6 QUIT
+7 ;
ONEDV ; -- Print Division totals
+1 IF IBQUIT
QUIT
+2 IF IOSL<($Y+5)
DO HDR
IF IBQUIT
QUIT
+3 IF ^TMP("DTOT",$JOB,IBDFDV)="0^0^0"&('$DATA(IBFLG4))
QUIT
+4 IF IBDFDVE=1
DO DASH
SET IBDFDVE=0
+5 DO LINE($EXTRACT(IBDFDV,1,25)_" ("_$PIECE($$SITE^VASITE(,$ORDER(^DG(40.8,"B",IBDFDV,0))),"^",3)_")",^TMP("DTOT",$JOB,IBDFDV))
+6 QUIT
+7 ;
LINE(NAME,IBX) ;
+1 ; -- print detail line
+2 ; input Name := text to be printed
+3 ; ibx ;= 3 piece global node containing data
+4 ;
+5 IF IOSL<($Y+5)
DO HDR
IF IBQUIT
QUIT
+6 WRITE !,$EXTRACT(NAME,1,35)
+7 WRITE ?39,$JUSTIFY($PIECE(IBX,"^",2),8)
+8 WRITE ?57,$JUSTIFY($PIECE(IBX,"^",3),8)
+9 QUIT
+10 ;
HDR ; -- Print header for report
+1 IF IBQUIT
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF IBPAG
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+4 SET IBPAG=IBPAG+1
+5 WRITE !,"# Encounters / CPT's, Dx",?(IOM-33),"Page ",IBPAG," ",IBHDT
+6 WRITE !,"For Period beginning on ",$$FMTE^XLFDT(IBBDT,2)," to ",$$FMTE^XLFDT(IBEDT,2)
+7 WRITE !,?44,"CPT",?56,"Diagnosis"
+8 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+9 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
WRITE !!,"....task stopped at user request"
QUIT
+10 QUIT
+11 ;
+12 ;
QUIT KILL ^TMP("MNTH",$JOB),^TMP("DTOT",$JOB),^TMP("GTOT",$JOB)
WRITE !
+1 QUIT
+2 ;
+3 ;
DASH WRITE !,"------------------",?39,"--------",?57,"--------"
+1 QUIT
+2 ;
DIVH ; -- Write division header
+1 IF IOSL<($Y+5)
DO HDR
IF IBQUIT
QUIT
+2 IF ^TMP("DTOT",$JOB,IBDFDV)="0^0^0"
QUIT
+3 WRITE !!,?(IOM-$LENGTH(IBDFDV)+10/2),"DIVISION: ",IBDFDV_" ("_$PIECE($$SITE^VASITE(,$ORDER(^DG(40.8,"B",IBDFDV,0))),"^",3)_")",!
+4 QUIT
