BDPUPDT ; IHS/CMI/TMJ - LISTING OF RECORDS BY DATE RANGE & CATEGORY ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;
;
D INFORM ;Report Explanation
;
ASK ;Ask For Date Range
;
;
BD ;get beginning date
W !! S DIR(0)="D^::EP",DIR("A")="Enter beginning Update Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G END
S BDPBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_BDPBD_":DT:EP",DIR("A")="Enter ending Update Date: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S BDPED=Y
S X1=BDPBD,X2=-1 D C^%DTC S BDPSD=X
W !
ZIS ;
S XBRC="PROC^BDPUPDT",XBRP="PRINT^BDPUPDT",XBNS="BDP",XBRX="END^BDPUPDT"
D ^XBDBQUE
D END
Q
PROC ;
;loop through file and tally by catgegory, skip inactive patients
S BDPJ=$J,BDPH=$H,BDPTCNT=0
K ^XTMP("BDPUPDT",BDPJ,BDPH)
D XTMP^APCLOSUT("BDPUPDT","DESG PROVIDER REPORT")
S BDPX=0 F S BDPX=$O(^BDPRECN("B",BDPX)) Q:BDPX="" D
.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 D=$P(^BDPRECN(BDPIEN,0),U,5)
..Q:D=""
..Q:D<BDPBD
..Q:D>BDPED
..S ^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",D,$$VAL^XBDIQ1(90360.1,BDPIEN,.01),BDPIEN)=""
..S BDPTCNT=BDPTCNT+1
..Q
.Q
Q
PRINT ;PRINT RECORDS BY DATE
;W !
S BDPPG=0 K BDPQUIT
D PAGEHEAD
I '$D(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS")) W !,"No data to report." D END Q
S BDPD="" F S BDPD=$O(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",BDPD)) Q:BDPD=""!($D(BDPQUIT)) D
.S BDPX=0 F S BDPX=$O(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",BDPD,BDPX)) Q:BDPX=""!($D(BDPQUIT)) D
..S BDPI=0 F S BDPI=$O(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",BDPD,BDPX,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,.04),1,20),?68,$$DATE^BDPLMDSP(BDPD)
I $D(BDPQUIT) G DONE
I $Y>(IOSL-3) D PAGEHEAD G:$D(BDPQUIT) DONE
W !!,"Total # of patients: ",BDPTCNT,!
DONE ;
K ^XTMP("BDPUPDT",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 DATE LAST UPDATED *",80)
W !,$$CTR("***************************************************************",80)
S X="Date Range: "_$$FMTE^XLFDT(BDPBD)_" through "_$$FMTE^XLFDT(BDPED) W !,$$CTR(X,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 Records updated for a",!,?10,"specific date range - entered by the User.",!
W !?10,"The report output includes:",!,?10,"Category Type-Patient Name-Current Provider-Date of Last Update.",!
W ?25,"*****************************",!
Q
BDPUPDT ; IHS/CMI/TMJ - LISTING OF RECORDS BY DATE RANGE & CATEGORY ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;
+4 ;
+5 ;Report Explanation
DO INFORM
+6 ;
ASK ;Ask For Date Range
+1 ;
+2 ;
BD ;get beginning date
+1 WRITE !!
SET DIR(0)="D^::EP"
SET DIR("A")="Enter beginning Update Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO END
+3 SET BDPBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_BDPBD_":DT:EP"
SET DIR("A")="Enter ending Update Date: "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET BDPED=Y
+4 SET X1=BDPBD
SET X2=-1
DO C^%DTC
SET BDPSD=X
+5 WRITE !
ZIS ;
+1 SET XBRC="PROC^BDPUPDT"
SET XBRP="PRINT^BDPUPDT"
SET XBNS="BDP"
SET XBRX="END^BDPUPDT"
+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
+3 KILL ^XTMP("BDPUPDT",BDPJ,BDPH)
+4 DO XTMP^APCLOSUT("BDPUPDT","DESG PROVIDER REPORT")
+5 SET BDPX=0
FOR
SET BDPX=$ORDER(^BDPRECN("B",BDPX))
IF BDPX=""
QUIT
Begin DoDot:1
+6 SET BDPIEN=0
FOR
SET BDPIEN=$ORDER(^BDPRECN("B",BDPX,BDPIEN))
IF BDPIEN=""
QUIT
Begin DoDot:2
+7 SET DFN=$PIECE(^BDPRECN(BDPIEN,0),U,2)
+8 ;inactive patients
IF $PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)
QUIT
+9 SET D=$PIECE(^BDPRECN(BDPIEN,0),U,5)
+10 IF D=""
QUIT
+11 IF D<BDPBD
QUIT
+12 IF D>BDPED
QUIT
+13 SET ^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",D,$$VAL^XBDIQ1(90360.1,BDPIEN,.01),BDPIEN)=""
+14 SET BDPTCNT=BDPTCNT+1
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
PRINT ;PRINT RECORDS BY DATE
+1 ;W !
+2 SET BDPPG=0
KILL BDPQUIT
+3 DO PAGEHEAD
+4 IF '$DATA(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS"))
WRITE !,"No data to report."
DO END
QUIT
+5 SET BDPD=""
FOR
SET BDPD=$ORDER(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",BDPD))
IF BDPD=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:1
+6 SET BDPX=0
FOR
SET BDPX=$ORDER(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",BDPD,BDPX))
IF BDPX=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:2
+7 SET BDPI=0
FOR
SET BDPI=$ORDER(^XTMP("BDPUPDT",BDPJ,BDPH,"HITS",BDPD,BDPX,BDPI))
IF BDPI=""!($DATA(BDPQUIT))
QUIT
Begin DoDot:3
+8 IF $Y>(IOSL-3)
DO PAGEHEAD
IF $DATA(BDPQUIT)
QUIT
+9 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,.04),1,20),?68,$$DATE^BDPLMDSP(BDPD)
End DoDot:3
End DoDot:2
End DoDot:1
+10 IF $DATA(BDPQUIT)
GOTO DONE
+11 IF $Y>(IOSL-3)
DO PAGEHEAD
IF $DATA(BDPQUIT)
GOTO DONE
+12 WRITE !!,"Total # of patients: ",BDPTCNT,!
DONE ;
+1 KILL ^XTMP("BDPUPDT",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 DATE LAST UPDATED *",80)
+5 WRITE !,$$CTR("***************************************************************",80)
+6 SET X="Date Range: "_$$FMTE^XLFDT(BDPBD)_" through "_$$FMTE^XLFDT(BDPED)
WRITE !,$$CTR(X,80)
+7 WRITE !!,"PROVIDER CATEGORY",?22,"PATIENT NAME",?44,"LAST CURRENT PROVIDER",?68,"UPDATE DT"
+8 WRITE !,$$REPEAT^XLFSTR("-",79)
+9 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 Records updated for a",!,?10,"specific date range - entered by the User.",!
+4 WRITE !?10,"The report output includes:",!,?10,"Category Type-Patient Name-Current Provider-Date of Last Update.",!
+5 WRITE ?25,"*****************************",!
+6 QUIT
