ACDBILLD.m

ACDBILLD ;IHS/ADC/EDE/KML - PURGE BILL FILE;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

 ; This routine purges entries in the CDMIS BILL file for

 ; a specified time frame.

 ;

START ;

 D MAIN

 D EOJ

 Q

 ;

MAIN ;

 D INIT

 Q:ACDQ

 D PURGE

 Q

 ;

INIT ;

 S ACDQ=1

 W !,"This routine purges entries in the CDMIS BILL file for a specified time frame",!

 D GETDTR^ACDDEU ;              get acddtlo & acddthi

 Q:ACDQ

 W !

 S DIR(0)="YO",DIR("A")="Purge entries within time frame that have not been printed",DIR("B")="NO" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 S ACDALL=Y

 S ACDPC=0

 S ACDQ=0

 Q

 ;

PURGE ; PURGE ENTRIES WITHIN TIME FRAME

 S ACDBDATE=$O(^ACDBILL("B",ACDDTLO),-1)

 F  S ACDBDATE=$O(^ACDBILL("B",ACDBDATE)) Q:ACDBDATE=""  Q:ACDBDATE>ACDDTHI  D

 .  S ACDBIEN=0

 .  F  S ACDBIEN=$O(^ACDBILL("B",ACDBDATE,ACDBIEN)) Q:'ACDBIEN  D

 ..  Q:'$D(^ACDBILL(ACDBIEN,0))  ;      corrupt database

 ..  S X=^ACDBILL(ACDBIEN,0)

 ..  I 'ACDALL,$P(X,U,7)="" Q  ;        quit if not printed

 ..  I ACDALL,$P(X,U,7)="" D  I ACD3PCOV D P3COV Q:ACDQ

 ...  S ACDDFNP=$P(X,U,2),ACDVIEN=$P(X,U,4)

 ...  D CHKCOV^ACDPCCL

 ...  Q

 ..  S DIK="^ACDBILL(",DA=ACDBIEN

 ..  D DIK^ACDFMC

 ..  W "."

 ..  S ACDPC=ACDPC+1

 ..  Q

 .  Q

 W !!,ACDPC," entr"_$S(ACDPC=1:"y",1:"ies")_" purged.",!!

 D PAUSE^ACDDEU

 Q

 ;

P3COV ; 3RD PARTY COVERAGE

 S ACDQ=1

 W !

 S DIC="^ACDBILL(",DA=ACDBIEN,DR=0

 D DIQ^ACDFMC

 W !,"There is third party coverage for this unprinted visit"

 S DIR(0)="Y",DIR("A")="Do you really want to purge this entry",DIR("B")="NO" K DA D ^DIR K DIR

 S:Y ACDQ=0

 Q

 ;

EOJ ;

 K ACD3PCOV,ACD3PDAT,ACDALL,ACDBDATE,ACDBIEN,ACDDFNP,ACDDTHI,ACDDTLO,ACDPC,ACDQ,ACDVIEN

 Q

ACDBILLD  ;IHS/ADC/EDE/KML - PURGE BILL FILE;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

 +3       ; This routine purges entries in the CDMIS BILL file for

 +4       ; a specified time frame.

 +5       ;

START     ;

 +1        DO MAIN

 +2        DO EOJ

 +3        QUIT 

 +4       ;

MAIN      ;

 +1        DO INIT

 +2        IF ACDQ

               QUIT 

 +3        DO PURGE

 +4        QUIT 

 +5       ;

INIT      ;

 +1        SET ACDQ=1

 +2        WRITE !,"This routine purges entries in the CDMIS BILL file for a specified time frame",!

 +3       ;              get acddtlo & acddthi

           DO GETDTR^ACDDEU

 +4        IF ACDQ

               QUIT 

 +5        WRITE !

 +6        SET DIR(0)="YO"

           SET DIR("A")="Purge entries within time frame that have not been printed"

           SET DIR("B")="NO"

           KILL DA

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               QUIT 

 +8        SET ACDALL=Y

 +9        SET ACDPC=0

 +10       SET ACDQ=0

 +11       QUIT 

 +12      ;

PURGE     ; PURGE ENTRIES WITHIN TIME FRAME

 +1        SET ACDBDATE=$ORDER(^ACDBILL("B",ACDDTLO),-1)

 +2        FOR 

               SET ACDBDATE=$ORDER(^ACDBILL("B",ACDBDATE))

               IF ACDBDATE=""

                   QUIT 

               IF ACDBDATE>ACDDTHI

                   QUIT 

               Begin DoDot:1

 +3                SET ACDBIEN=0

 +4                FOR 

                       SET ACDBIEN=$ORDER(^ACDBILL("B",ACDBDATE,ACDBIEN))

                       IF 'ACDBIEN

                           QUIT 

                       Begin DoDot:2

 +5       ;      corrupt database

                           IF '$DATA(^ACDBILL(ACDBIEN,0))

                               QUIT 

 +6                        SET X=^ACDBILL(ACDBIEN,0)

 +7       ;        quit if not printed

                           IF 'ACDALL

                               IF $PIECE(X,U,7)=""

                                   QUIT 

 +8                        IF ACDALL

                               IF $PIECE(X,U,7)=""

                                   Begin DoDot:3

 +9                                    SET ACDDFNP=$PIECE(X,U,2)

                                       SET ACDVIEN=$PIECE(X,U,4)

 +10                                   DO CHKCOV^ACDPCCL

 +11                                   QUIT 

                                   End DoDot:3

                                   IF ACD3PCOV

                                       DO P3COV

                                       IF ACDQ

                                           QUIT 

 +12                       SET DIK="^ACDBILL("

                           SET DA=ACDBIEN

 +13                       DO DIK^ACDFMC

 +14                       WRITE "."

 +15                       SET ACDPC=ACDPC+1

 +16                       QUIT 

                       End DoDot:2

 +17               QUIT 

               End DoDot:1

 +18       WRITE !!,ACDPC," entr"_$SELECT(ACDPC=1:"y",1:"ies")_" purged.",!!

 +19       DO PAUSE^ACDDEU

 +20       QUIT 

 +21      ;

P3COV     ; 3RD PARTY COVERAGE

 +1        SET ACDQ=1

 +2        WRITE !

 +3        SET DIC="^ACDBILL("

           SET DA=ACDBIEN

           SET DR=0

 +4        DO DIQ^ACDFMC

 +5        WRITE !,"There is third party coverage for this unprinted visit"

 +6        SET DIR(0)="Y"

           SET DIR("A")="Do you really want to purge this entry"

           SET DIR("B")="NO"

           KILL DA

           DO ^DIR

           KILL DIR

 +7        IF Y

               SET ACDQ=0

 +8        QUIT 

 +9       ;

EOJ       ;

 +1        KILL ACD3PCOV,ACD3PDAT,ACDALL,ACDBDATE,ACDBIEN,ACDDFNP,ACDDTHI,ACDDTLO,ACDPC,ACDQ,ACDVIEN

 +2        QUIT