- 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
