ACDBILLS.m

ACDBILLS ;IHS/ADC/EDE/KML - BILL FILE STATUS;

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

 ;

 ; This routine prints the status of the CDMIS BILL file

 ; entries.

 ;

START ;

 D MAIN

 D EOJ

 Q

 ;

MAIN ;

 D INIT

 Q:ACDQ

 D DBQUE

 Q

 ;

INIT ;

 S ACDQ=1

 S (ACDCTR,ACDCPR,ACDCNP,ACDCCV,ACDFC1,ACDFC2,ACDFC3)=0

 S ACDQ=0

 Q

 ;

DBQUE ; call to XBDBQUE

 S XBRP="STATUS^ACDBILLS",XBRC="CMP^ACDBILLS",XBRX="EOJ^ACDBILLS",XBNS="ACD"

 D ^XBDBQUE

 Q

 ;

CMP ; EP-FOR XBDBQUE

 ; all action takes place in status EP

 Q

 ;

STATUS ; EP-RINT BILL FILE STATUS

 S ACDBIEN=0

 F  S ACDBIEN=$O(^ACDBILL(ACDBIEN)) Q:'ACDBIEN  D COUNT

 D PRINT

 D PAUSE^ACDDEU

 Q

 ;

PRINT ; PRINT OUTPUT

 D HEAD

 W "RECORD COUNT",?22,"IIF",?35,"TDC",?50,"CS",!

 W ?3,$J(ACDCTR,5),?20,$J(ACDFC1,5),?33,$J(ACDFC2,5),?47,$J(ACDFC3,5),!

 W !,"PRINTED    NOT PRINTED     COVERAGE",!

 W ?1,$J(ACDCPR,5),?15,$J(ACDCNP,5),?28,$J(ACDCCV,5),!

 Q

 ;

COUNT ; COUNT EACH RECORD

 S ACDCTR=ACDCTR+1

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

 S X=^ACDBILL(ACDBIEN,0)

 S Y="ACDFC"_$P(X,U,3) S @Y=@Y+1

 I $P(X,U,7)'="" S ACDCPR=ACDCPR+1 Q

 S ACDCNP=ACDCNP+1

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

 D CHKCOV^ACDPCCL

 S ACDCCV=ACDCCV+ACD3PCOV

 Q

 ;

HEAD ; PRINT HEADER

 I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)="C-" W @IOF

 W !,$$CTR^ACD("CDMIS BILL FILE STATUS REFPORT",80),!!

 W "Run at ",ACDSITE," for ",$$USR^ACD()," on ",$$FMTE^XLFDT(DT),!

 W $$REPEAT^XLFSTR("=",80),!!

 Q

 ;

EOJ ;

 K ACD3PCOV,ACD3PDAT,ACDFC1,ACDFC2,ACDFC3

 K ACDBIEN,ACDCCV,ACDCNP,ACDCPR,ACDCTR,ACDDFNP,ACDQ,ACDVIEN

 Q

ACDBILLS  ;IHS/ADC/EDE/KML - BILL FILE STATUS;

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

 +2       ;

 +3       ; This routine prints the status of the CDMIS BILL file

 +4       ; entries.

 +5       ;

START     ;

 +1        DO MAIN

 +2        DO EOJ

 +3        QUIT 

 +4       ;

MAIN      ;

 +1        DO INIT

 +2        IF ACDQ

               QUIT 

 +3        DO DBQUE

 +4        QUIT 

 +5       ;

INIT      ;

 +1        SET ACDQ=1

 +2        SET (ACDCTR,ACDCPR,ACDCNP,ACDCCV,ACDFC1,ACDFC2,ACDFC3)=0

 +3        SET ACDQ=0

 +4        QUIT 

 +5       ;

DBQUE     ; call to XBDBQUE

 +1        SET XBRP="STATUS^ACDBILLS"

           SET XBRC="CMP^ACDBILLS"

           SET XBRX="EOJ^ACDBILLS"

           SET XBNS="ACD"

 +2        DO ^XBDBQUE

 +3        QUIT 

 +4       ;

CMP       ; EP-FOR XBDBQUE

 +1       ; all action takes place in status EP

 +2        QUIT 

 +3       ;

STATUS    ; EP-RINT BILL FILE STATUS

 +1        SET ACDBIEN=0

 +2        FOR 

               SET ACDBIEN=$ORDER(^ACDBILL(ACDBIEN))

               IF 'ACDBIEN

                   QUIT 

               DO COUNT

 +3        DO PRINT

 +4        DO PAUSE^ACDDEU

 +5        QUIT 

 +6       ;

PRINT     ; PRINT OUTPUT

 +1        DO HEAD

 +2        WRITE "RECORD COUNT",?22,"IIF",?35,"TDC",?50,"CS",!

 +3        WRITE ?3,$JUSTIFY(ACDCTR,5),?20,$JUSTIFY(ACDFC1,5),?33,$JUSTIFY(ACDFC2,5),?47,$JUSTIFY(ACDFC3,5),!

 +4        WRITE !,"PRINTED    NOT PRINTED     COVERAGE",!

 +5        WRITE ?1,$JUSTIFY(ACDCPR,5),?15,$JUSTIFY(ACDCNP,5),?28,$JUSTIFY(ACDCCV,5),!

 +6        QUIT 

 +7       ;

COUNT     ; COUNT EACH RECORD

 +1        SET ACDCTR=ACDCTR+1

 +2       ;          corrupt database

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

               QUIT 

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

 +4        SET Y="ACDFC"_$PIECE(X,U,3)

           SET @Y=@Y+1

 +5        IF $PIECE(X,U,7)'=""

               SET ACDCPR=ACDCPR+1

               QUIT 

 +6        SET ACDCNP=ACDCNP+1

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

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

 +8        DO CHKCOV^ACDPCCL

 +9        SET ACDCCV=ACDCCV+ACD3PCOV

 +10       QUIT 

 +11      ;

HEAD      ; PRINT HEADER

 +1        IF '$DATA(ZTQUEUED)

               IF '$DATA(IO("S"))

                   IF $EXTRACT(IOST,1,2)="C-"

                       WRITE @IOF

 +2        WRITE !,$$CTR^ACD("CDMIS BILL FILE STATUS REFPORT",80),!!

 +3        WRITE "Run at ",ACDSITE," for ",$$USR^ACD()," on ",$$FMTE^XLFDT(DT),!

 +4        WRITE $$REPEAT^XLFSTR("=",80),!!

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL ACD3PCOV,ACD3PDAT,ACDFC1,ACDFC2,ACDFC3

 +2        KILL ACDBIEN,ACDCCV,ACDCNP,ACDCPR,ACDCTR,ACDDFNP,ACDQ,ACDVIEN

 +3        QUIT