- 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
