BMCBMRG.m

BMCBMRG ;IHS/ITSC/FCJ - MERGE BULLETIN MESSAGES SENT 

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

 W:$D(IOF) @IOF

 W !,"This option will merge data from the RCIS Messages File.  This file"

 W !,"holds the date and group(s) messages were sent for a specific Referral.",!

 W !,"This will not remove the message from the Mail box."

 ;Find earliest date....

 S Y=0 S Y=$O(^BMCMSG("B",Y)),Y=$P(Y,".") D DD^%DT S BMCBDT=Y

BDT ;ENTER DATE RANGE

 S DIR(0)="D",DIR("B")=BMCBDT

 S DIR("A")="Enter the beginning date for purging messages, earliest date"

 D ^DIR G:$D(DIRUT) EXT

 S BMCBDT=Y,BMCBDTD=Y(0)

 K DIR("B")

EDT S DIR("A")="Enter the ending date for purging messages"

 D ^DIR G:$D(DIRUT) EXT

 K DIR

 I BMCBDT>Y W !,"Beginning date is greater then Ending Date" G EDT

 S BMCEDT=Y,BMCEDTD=Y(0)

 W !!,"Message will be purged beginning with ",BMCBDTD," THRU ",BMCEDTD,".",!

 S DIR("B")="N"

 S DIR(0)="Y",DIR("A")="Enter Yes to continue, No to exit"

 D ^DIR

 G:'Y EXT

REM ;REMOVE ENTRIES FROM RCIS MESSAGES

 W !,"REMOVING ENTRIES"

 S BMCDT=BMCBDT,BMCT=0

 F  S BMCDT=$O(^BMCMSG("B",BMCDT)) Q:(BMCDT="")!(BMCDT>BMCEDT)  D

 .S BMCMIEN=0

 .F  S BMCMIEN=$O(^BMCMSG("B",BMCDT,BMCMIEN)) Q:BMCMIEN'?1N.N  D

 ..S DIK="^BMCMSG(",DA=BMCMIEN D ^DIK

 ..W "." S BMCT=BMCT+1

 W !,"TOTAL REMOVED = ",BMCT

EXT ;

 K BMCMIEN,BMCT,BMCDT,BMCEDT,BMCEDTD,BMCBDT,BMCBDTD

 K DIR,DIC,DIK,DA,Y,X

 Q

BMCBMRG   ;IHS/ITSC/FCJ - MERGE BULLETIN MESSAGES SENT 

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3        IF $DATA(IOF)

               WRITE @IOF

 +4        WRITE !,"This option will merge data from the RCIS Messages File.  This file"

 +5        WRITE !,"holds the date and group(s) messages were sent for a specific Referral.",!

 +6        WRITE !,"This will not remove the message from the Mail box."

 +7       ;Find earliest date....

 +8        SET Y=0

           SET Y=$ORDER(^BMCMSG("B",Y))

           SET Y=$PIECE(Y,".")

           DO DD^%DT

           SET BMCBDT=Y

BDT       ;ENTER DATE RANGE

 +1        SET DIR(0)="D"

           SET DIR("B")=BMCBDT

 +2        SET DIR("A")="Enter the beginning date for purging messages, earliest date"

 +3        DO ^DIR

           IF $DATA(DIRUT)

               GOTO EXT

 +4        SET BMCBDT=Y

           SET BMCBDTD=Y(0)

 +5        KILL DIR("B")

EDT        SET DIR("A")="Enter the ending date for purging messages"

 +1        DO ^DIR

           IF $DATA(DIRUT)

               GOTO EXT

 +2        KILL DIR

 +3        IF BMCBDT>Y

               WRITE !,"Beginning date is greater then Ending Date"

               GOTO EDT

 +4        SET BMCEDT=Y

           SET BMCEDTD=Y(0)

 +5        WRITE !!,"Message will be purged beginning with ",BMCBDTD," THRU ",BMCEDTD,".",!

 +6        SET DIR("B")="N"

 +7        SET DIR(0)="Y"

           SET DIR("A")="Enter Yes to continue, No to exit"

 +8        DO ^DIR

 +9        IF 'Y

               GOTO EXT

REM       ;REMOVE ENTRIES FROM RCIS MESSAGES

 +1        WRITE !,"REMOVING ENTRIES"

 +2        SET BMCDT=BMCBDT

           SET BMCT=0

 +3        FOR 

               SET BMCDT=$ORDER(^BMCMSG("B",BMCDT))

               IF (BMCDT="")!(BMCDT>BMCEDT)

                   QUIT 

               Begin DoDot:1

 +4                SET BMCMIEN=0

 +5                FOR 

                       SET BMCMIEN=$ORDER(^BMCMSG("B",BMCDT,BMCMIEN))

                       IF BMCMIEN'?1N.N

                           QUIT 

                       Begin DoDot:2

 +6                        SET DIK="^BMCMSG("

                           SET DA=BMCMIEN

                           DO ^DIK

 +7                        WRITE "."

                           SET BMCT=BMCT+1

                       End DoDot:2

               End DoDot:1

 +8        WRITE !,"TOTAL REMOVED = ",BMCT

EXT       ;

 +1        KILL BMCMIEN,BMCT,BMCDT,BMCEDT,BMCEDTD,BMCBDT,BMCBDTD

 +2        KILL DIR,DIC,DIK,DA,Y,X

 +3        QUIT