Routine: BCHPCCBL

BCHPCCBL ; IHS/CMI/LAB - back load chr visits to PCC ;

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 W:$D(IOF) @IOF

 W !!,"This routine will loop through all CHR records for a time frame you specify",!,"and if there is no PCC visit already created it will fire the CHR to PCC",!,"link for that record.",!!

 W !!,"This routine should be used if the PCC link was turned off for some reason",!,"or another.",!!

GETDATES ;

 S BCHBLCNT=0

BD ;get beginning date

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter BEGINNING Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S BCHBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_BCHBD_":DT:EP",DIR("A")="Enter ENDING Visit Date" S Y=BCHBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S BCHED=Y

 S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X

 S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D XIT Q

 I 'Y D XIT Q

PROCESS ;

 F  S BCHSD=$O(^BCHR("B",BCHSD)) Q:BCHSD=""!(BCHSD>BCHED)  D

 .S BCHR=0 F  S BCHR=$O(^BCHR("B",BCHSD,BCHR)) Q:BCHR'=+BCHR  D

 ..Q:'$D(^BCHR(BCHR,0))

 ..Q:$P(^BCHR(BCHR,0),U,15)]""

 ..S BCHEV("TYPE")="A"

 ..D PROTOCOL^BCHUADD1

 ..S BCHBLCNT=BCHBLCNT+1

..Q

.Q

 W !!,"All done. ",BCHBLCNT," records were reviewed and processed.",!

 D XIT

XIT ;

 D EN^XBVK("BCH")

BCHPCCBL  ; IHS/CMI/LAB - back load chr visits to PCC ;

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE !!,"This routine will loop through all CHR records for a time frame you specify",!,"and if there is no PCC visit already created it will fire the CHR to PCC",!,"link for that record.",!!

 +6        WRITE !!,"This routine should be used if the PCC link was turned off for some reason",!,"or another.",!!

GETDATES  ;

 +1        SET BCHBLCNT=0

BD        ;get beginning date

 +1        WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter BEGINNING Visit Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET BCHBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_BCHBD_":DT:EP"

           SET DIR("A")="Enter ENDING Visit Date"

           SET Y=BCHBD

           DO DD^%DT

           SET DIR("B")=Y

           SET Y=""

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET BCHED=Y

 +4        SET X1=BCHBD

           SET X2=-1

           DO C^%DTC

           SET BCHSD=X

 +5        SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to continue"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               DO XIT

               QUIT

 +7        IF 'Y

               DO XIT

               QUIT

PROCESS   ;

 +1        FOR

               SET BCHSD=$ORDER(^BCHR("B",BCHSD))

               IF BCHSD=""!(BCHSD>BCHED)

                   QUIT

               Begin DoDot:1

 +2                SET BCHR=0

FOR

                       SET BCHR=$ORDER(^BCHR("B",BCHSD,BCHR))

                       IF BCHR'=+BCHR

                           QUIT

                       Begin DoDot:2

 +3                        IF '$DATA(^BCHR(BCHR,0))

                               QUIT

 +4                        IF $PIECE(^BCHR(BCHR,0),U,15)]""

                               QUIT

 +5                        SET BCHEV("TYPE")="A"

 +6                        DO PROTOCOL^BCHUADD1

 +7                        SET BCHBLCNT=BCHBLCNT+1

 +8                        QUIT

                       End DoDot:2

 +9                QUIT

               End DoDot:1

 +10       WRITE !!,"All done. ",BCHBLCNT," records were reviewed and processed.",!

 +11       DO XIT

 +12       QUIT

XIT       ;

 +1        DO EN^XBVK("BCH")

 +2        QUIT

BCHPCCBL.m