BDPPLBC ; IHS/CMI/TMJ - LISTING OF RECORDS BY DATE RANGE & CATEGORY ;
;;2.0;IHS PCC SUITE;**2,20**;MAY 14, 2009;Build 25
;
;
;
D INFORM ;Report Explanation
CAT ;
W !
K BDPPROVC
S DIR(0)="SO^O:One Provider Category;A:All Provider Categories",DIR("A")="Do you want to report on ",DIR("B")="O" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D END Q
I Y="A" G ZIS
S DIC="^BDPTCAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA
I Y=-1 G CAT
S BDPPROVC=+Y
ZIS ;
S XBRC="PROC^BDPPLBC",XBRP="PRINT^BDPPLBC",XBNS="BDP",XBRX="END^BDPPLBC"
D ^XBDBQUE
D END
Q
PROC ;
;loop through file and tally by catgegory, skip inactive patients
S BDPJ=$J,BDPH=$H,BDPTCNT=0 K BDPSCNT
K ^XTMP("BDPPLBC",BDPJ,BDPH)
D XTMP^APCLOSUT("BDPPLBC","DESG PROVIDER REPORT")
S BDPX=0 F S BDPX=$O(^BDPRECN("B",BDPX)) Q:BDPX="" D
.I $D(BDPPROVC),BDPX'=BDPPROVC Q
.S BDPIEN=0 F S BDPIEN=$O(^BDPRECN("B",BDPX,BDPIEN)) Q:BDPIEN="" D
..S DFN=$P(^BDPRECN(BDPIEN,0),U,2)
..Q:$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,3) ;inactive patients
..S BDPD=$$VAL^XBDIQ1(90360.1,BDPIEN,.01)
..Q:$$VAL^XBDIQ1(90360.1,BDPIEN,.03)=""
..S ^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",$$VAL^XBDIQ1(90360.1,BDPIEN,.01),$$VAL^XBDIQ1(90360.1,BDPIEN,.03),BDPIEN)=""
..S BDPTCNT=BDPTCNT+1 S BDPSCNT(BDPD)=$G(BDPSCNT(BDPD))+1
..Q
.Q
Q
PRINT ;PRINT RECORDS BY DATE
S BDPPG=0 K BDPQUIT
D PAGEHEAD
I '$D(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS")) W !,"No data to report." D END Q
S BDPD="" F S BDPD=$O(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD)) Q:BDPD=""!($D(BDPQUIT)) D
.S BDPPN=0 F S BDPPN=$O(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD,BDPPN)) Q:BDPPN=""!($D(BDPQUIT)) D
..S BDPI=0 F S BDPI=$O(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD,BDPPN,BDPI)) Q:BDPI=""!($D(BDPQUIT)) D
...I $Y>(IOSL-3) D PAGEHEAD Q:$D(BDPQUIT)
...W !,$E($$VAL^XBDIQ1(90360.1,BDPI,.01),1,20),?22,$E($$VAL^XBDIQ1(90360.1,BDPI,.02),1,20),?44,$E($$VAL^XBDIQ1(90360.1,BDPI,.03),1,20),?68,$$DATE^BDPLMDSP($$VALI^XBDIQ1(90360.1,BDPI,.05))
.I $Y>(IOSL-3) D PAGEHEAD Q:$D(BDPQUIT)
.W !,"Subcount: ",BDPSCNT(BDPD),!
I $D(BDPQUIT) G DONE
DONE ;
K ^XTMP("BDPPLBC",BDPJ,BDPH)
D END
Q
END ;
D EN^XBVK("BDP")
Q
;
PAGEHEAD ;
HEAD ;EP;HEADER
G:$D(BDPDEM)!($D(BDPDEMM)) HEAD2
I 'BDPPG G HEAD1
HEAD2 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDPQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S BDPPG=BDPPG+1
W !,$$FMTE^XLFDT(DT),?70,"Page: ",BDPPG
W !,$$CTR("******************************************************",80)
W !,$$CTR("* DESIGNATED PROVIDER LIST BY CATEGORY *",80)
W !,$$CTR("******************************************************",80)
W !!,"PROVIDER CATEGORY",?22,"PATIENT NAME",?44,"LAST CURRENT PROVIDER",?68,"UPDATE DT"
W !,$$REPEAT^XLFSTR("-",79)
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;
INFORM ;Report Explanation
;
W !,?25,"******************************",!
W ?10,"This Report prints a Listing of patients by the provider category."
W !?10,"The report output includes:",!,?10,"Category Type-Patient Name-Current Provider-Date of Last Update.",!
W ?25,"*****************************",!
Q
BDPPLBC ; IHS/CMI/TMJ - LISTING OF RECORDS BY DATE RANGE & CATEGORY ;
+1 ;;2.0;IHS PCC SUITE;**2,20**;MAY 14, 2009;Build 25
+2 ;
+3 ;
+4 ;
+5 ;Report Explanation
DO INFORM
CAT ;
+1 WRITE !
+2 KILL BDPPROVC
+3 SET DIR(0)="SO^O:One Provider Category;A:All Provider Categories"
SET DIR("A")="Do you want to report on "
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
DO END
QUIT
+5 IF Y="A"
GOTO ZIS
+6 SET DIC="^BDPTCAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
+7 IF Y=-1
GOTO CAT
+8 SET BDPPROVC=+Y
ZIS ;
+1 SET XBRC="PROC^BDPPLBC"
SET XBRP="PRINT^BDPPLBC"
SET XBNS="BDP"
SET XBRX="END^BDPPLBC"
+2 DO ^XBDBQUE
+3 DO END
+4 QUIT
PROC ;
+1 ;loop through file and tally by catgegory, skip inactive patients
+2 SET BDPJ=$JOB
SET BDPH=$HOROLOG
SET BDPTCNT=0
KILL BDPSCNT
+3 KILL ^XTMP("BDPPLBC",BDPJ,BDPH)
+4 DO XTMP^APCLOSUT("BDPPLBC","DESG PROVIDER REPORT")
+5 SET BDPX=0
FOR
SET BDPX=$ORDER(^BDPRECN("B",BDPX))
IF BDPX=""
QUIT
Begin DoDot:1
+6 IF $DATA(BDPPROVC)
IF BDPX'=BDPPROVC
QUIT
+7 SET BDPIEN=0
FOR
SET BDPIEN=$ORDER(^BDPRECN("B",BDPX,BDPIEN))
IF BDPIEN=""
QUIT
Begin DoDot:2
+8 SET DFN=$PIECE(^BDPRECN(BDPIEN,0),U,2)
+9 ;inactive patients
IF $PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)
QUIT
+10 SET BDPD=$$VAL^XBDIQ1(90360.1,BDPIEN,.01)
+11 IF $$VAL^XBDIQ1(90360.1,BDPIEN,.03)=""
QUIT
+12 SET ^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",$$VAL^XBDIQ1(90360.1,BDPIEN,.01),$$VAL^XBDIQ1(90360.1,BDPIEN,.03),BDPIEN)=""
+13 SET BDPTCNT=BDPTCNT+1
SET BDPSCNT(BDPD)=$GET(BDPSCNT(BDPD))+1
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
PRINT ;PRINT RECORDS BY DATE
+1 SET BDPPG=0
KILL BDPQUIT
+2 DO PAGEHEAD
+3 IF '$DATA(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS"))
WRITE !,"No data to report."
DO END
QUIT
+4 SET BDPD=""
FOR
SET BDPD=$ORDER(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD))
IF BDPD=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:1
+5 SET BDPPN=0
FOR
SET BDPPN=$ORDER(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD,BDPPN))
IF BDPPN=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:2
+6 SET BDPI=0
FOR
SET BDPI=$ORDER(^XTMP("BDPPLBC",BDPJ,BDPH,"HITS",BDPD,BDPPN,BDPI))
IF BDPI=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:3
+7 IF $Y>(IOSL-3)
DO PAGEHEAD
IF $DATA(BDPQUIT)
QUIT
+8 WRITE !,$EXTRACT($$VAL^XBDIQ1(90360.1,BDPI,.01),1,20),?22,$EXTRACT($$VAL^XBDIQ1(90360.1,BDPI,.02),1,20),?44,$EXTRACT($$VAL^XBDIQ1(90360.1,BDPI,.03),1,20),?68,$$DATE^BDPLMDSP($$VALI^XBDIQ1(90360.1,BDPI,.05))
End DoDot:3
End DoDot:2
+9 IF $Y>(IOSL-3)
DO PAGEHEAD
IF $DATA(BDPQUIT)
QUIT
+10 WRITE !,"Subcount: ",BDPSCNT(BDPD),!
End DoDot:1
+11 IF $DATA(BDPQUIT)
GOTO DONE
DONE ;
+1 KILL ^XTMP("BDPPLBC",BDPJ,BDPH)
+2 DO END
+3 QUIT
END ;
+1 DO EN^XBVK("BDP")
+2 QUIT
+3 ;
PAGEHEAD ;
HEAD ;EP;HEADER
+1 IF $DATA(BDPDEM)!($DATA(BDPDEMM))
GOTO HEAD2
+2 IF 'BDPPG
GOTO HEAD1
HEAD2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDPQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BDPPG=BDPPG+1
+2 WRITE !,$$FMTE^XLFDT(DT),?70,"Page: ",BDPPG
+3 WRITE !,$$CTR("******************************************************",80)
+4 WRITE !,$$CTR("* DESIGNATED PROVIDER LIST BY CATEGORY *",80)
+5 WRITE !,$$CTR("******************************************************",80)
+6 WRITE !!,"PROVIDER CATEGORY",?22,"PATIENT NAME",?44,"LAST CURRENT PROVIDER",?68,"UPDATE DT"
+7 WRITE !,$$REPEAT^XLFSTR("-",79)
+8 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;
INFORM ;Report Explanation
+1 ;
+2 WRITE !,?25,"******************************",!
+3 WRITE ?10,"This Report prints a Listing of patients by the provider category."
+4 WRITE !?10,"The report output includes:",!,?10,"Category Type-Patient Name-Current Provider-Date of Last Update.",!
+5 WRITE ?25,"*****************************",!
+6 QUIT
