Routine: BDPUPDT

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

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

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

END ;

 D EN^XBVK("BDP")

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)

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,"*****************************",!

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

BDPUPDT.m