ACDBILLP ;IHS/ADC/EDE/KML - PRINT BILL REPORT;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine prints the hardcopy for billing report for
; a specified time frame.
;
START ;
D INIT
Q:ACDQ
D DBQUE
Q
;
INIT ;
S ACDQ=1
W !,"This routine prints the hardcopy for billing report for a specified time frame",!
D GETDTR^ACDDEU ; get acddtlo & acddthi
Q:ACDQ
W !
S DIR(0)="YO",DIR("A")="Print hardcopy only for patients with third party coverage",DIR("B")="YES" K DA D ^DIR K DIR
Q:$D(DIRUT)
S ACD3PO=Y
S DIR(0)="YO",DIR("A")="Re-print entries already printed",DIR("B")="NO" K DA D ^DIR K DIR
Q:$D(DIRUT)
S ACDRPR=Y
S ACDQ=0
Q
;
DBQUE ; call to XBDBQUE
S ACDQ=1
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
Q:$D(DIRUT)
I Y="B" D BROWSE Q
S XBRP="PRT^ACDBILLP",XBRC="CMP^ACDBILLP",XBRX="EOJ^ACDBILLP",XBNS="ACD"
D ^XBDBQUE
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRT^ACDBILLP"")"
S XBRC="CMP^ACDBILLP",XBRX="EOJ^ACDBILLP",XBIOP=0
D ^XBDBQUE
Q
;
CMP ; EP-COMPUTE ENTRY POINT FOR ^XBDBQUE
; All action taken in PRT entry point
Q
;
PRT ; EP-PRINT ENTRY POINT FOR ^XBDBQUE
; Print hardcopies for billing
NEW ACDFHCP
S ACDMODE="A",ACDFHCP=1
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 K ACDPCCL,ACD3PCOV
.. Q:'$D(^ACDBILL(ACDBIEN,0)) ; corrupt database
.. S X=^ACDBILL(ACDBIEN,0)
.. I 'ACDRPR,$P(X,U,7) Q ; quit if already printed
.. K ACDMODEE I $P(X,U,9) S ACDMODEE="" ; modified bill
.. S ACDDFNP=$P(X,U,2),ACDFILE=$P(X,U,3),ACDVIEN=$P(X,U,4)
.. S ACDPCCL(ACDDFNP,ACDVIEN)=""
.. I ACDFILE'=3 S ACDPCCL(ACDDFNP,ACDVIEN,$S(ACDFILE=2:"TDC",1:"IIF"),$S(ACDFILE=2:$P(X,U,6),1:$P(X,U,5)))=""
.. I ACDFILE=3 D
... S ACDCSIEN=0
... F S ACDCSIEN=$O(^ACDBILL(ACDBIEN,21,ACDCSIEN)) Q:'ACDCSIEN D
.... S Y=+^ACDBILL(ACDBIEN,21,ACDCSIEN,0)
.... Q:'$D(^ACDCS(Y,0))
.... S ACDPCCL(ACDDFNP,ACDVIEN,"CS",Y)=""
.... Q
... Q
.. I ACD3PO D CHKCOV^ACDPCCL I 'ACD3PCOV Q ;quit if no coverage
.. D GENEVENT^ACDPCCL2
.. Q:ACDQ
.. D WRTBILLP^ACDPCCL4
.. D EOJ^ACDPCCL4
.. K ACDEV
.. S DIE="^ACDBILL(",DA=ACDBIEN,DR=".07////"_DT_";.08////"_DUZ
.. D DIE^ACDFMC
.. Q
. Q
Q
;
EOJ ; EP-CALLED BY XBDBQUE
W:IOST["P-" @IOF
K %,%1,%2,%3,%DT,F,M,V,W,X,Y,Z
K ACD3PDAT,ACD3PO,ACDMODE,ACDBDATE,ACDDTLO,ACDDTHI,ACDBIEN,ACDDFNP,ACDFILE,ACDRPR,ACDVIEN,ACDCSIEN,ACD3PCOV
Q
ACDBILLP ;IHS/ADC/EDE/KML - PRINT BILL REPORT;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine prints the hardcopy for billing report for
+4 ; a specified time frame.
+5 ;
START ;
+1 DO INIT
+2 IF ACDQ
QUIT
+3 DO DBQUE
+4 QUIT
+5 ;
INIT ;
+1 SET ACDQ=1
+2 WRITE !,"This routine prints the hardcopy for billing report 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")="Print hardcopy only for patients with third party coverage"
SET DIR("B")="YES"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET ACD3PO=Y
+9 SET DIR(0)="YO"
SET DIR("A")="Re-print entries already printed"
SET DIR("B")="NO"
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
QUIT
+11 SET ACDRPR=Y
+12 SET ACDQ=0
+13 QUIT
+14 ;
DBQUE ; call to XBDBQUE
+1 SET ACDQ=1
+2 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y="B"
DO BROWSE
QUIT
+5 SET XBRP="PRT^ACDBILLP"
SET XBRC="CMP^ACDBILLP"
SET XBRX="EOJ^ACDBILLP"
SET XBNS="ACD"
+6 DO ^XBDBQUE
+7 QUIT
+8 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRT^ACDBILLP"")"
+2 SET XBRC="CMP^ACDBILLP"
SET XBRX="EOJ^ACDBILLP"
SET XBIOP=0
+3 DO ^XBDBQUE
+4 QUIT
+5 ;
CMP ; EP-COMPUTE ENTRY POINT FOR ^XBDBQUE
+1 ; All action taken in PRT entry point
+2 QUIT
+3 ;
PRT ; EP-PRINT ENTRY POINT FOR ^XBDBQUE
+1 ; Print hardcopies for billing
+2 NEW ACDFHCP
+3 SET ACDMODE="A"
SET ACDFHCP=1
+4 SET ACDBDATE=$ORDER(^ACDBILL("B",ACDDTLO),-1)
+5 FOR
SET ACDBDATE=$ORDER(^ACDBILL("B",ACDBDATE))
IF ACDBDATE=""
QUIT
IF ACDBDATE>ACDDTHI
QUIT
Begin DoDot:1
+6 SET ACDBIEN=0
+7 FOR
SET ACDBIEN=$ORDER(^ACDBILL("B",ACDBDATE,ACDBIEN))
IF 'ACDBIEN
QUIT
Begin DoDot:2
+8 ; corrupt database
IF '$DATA(^ACDBILL(ACDBIEN,0))
QUIT
+9 SET X=^ACDBILL(ACDBIEN,0)
+10 ; quit if already printed
IF 'ACDRPR
IF $PIECE(X,U,7)
QUIT
+11 ; modified bill
KILL ACDMODEE
IF $PIECE(X,U,9)
SET ACDMODEE=""
+12 SET ACDDFNP=$PIECE(X,U,2)
SET ACDFILE=$PIECE(X,U,3)
SET ACDVIEN=$PIECE(X,U,4)
+13 SET ACDPCCL(ACDDFNP,ACDVIEN)=""
+14 IF ACDFILE'=3
SET ACDPCCL(ACDDFNP,ACDVIEN,$SELECT(ACDFILE=2:"TDC",1:"IIF"),$SELECT(ACDFILE=2:$PIECE(X,U,6),1:$PIECE(X,U,5)))=""
+15 IF ACDFILE=3
Begin DoDot:3
+16 SET ACDCSIEN=0
+17 FOR
SET ACDCSIEN=$ORDER(^ACDBILL(ACDBIEN,21,ACDCSIEN))
IF 'ACDCSIEN
QUIT
Begin DoDot:4
+18 SET Y=+^ACDBILL(ACDBIEN,21,ACDCSIEN,0)
+19 IF '$DATA(^ACDCS(Y,0))
QUIT
+20 SET ACDPCCL(ACDDFNP,ACDVIEN,"CS",Y)=""
+21 QUIT
End DoDot:4
+22 QUIT
End DoDot:3
+23 ;quit if no coverage
IF ACD3PO
DO CHKCOV^ACDPCCL
IF 'ACD3PCOV
QUIT
+24 DO GENEVENT^ACDPCCL2
+25 IF ACDQ
QUIT
+26 DO WRTBILLP^ACDPCCL4
+27 DO EOJ^ACDPCCL4
+28 KILL ACDEV
+29 SET DIE="^ACDBILL("
SET DA=ACDBIEN
SET DR=".07////"_DT_";.08////"_DUZ
+30 DO DIE^ACDFMC
+31 QUIT
End DoDot:2
KILL ACDPCCL,ACD3PCOV
+32 QUIT
End DoDot:1
+33 QUIT
+34 ;
EOJ ; EP-CALLED BY XBDBQUE
+1 IF IOST["P-"
WRITE @IOF
+2 KILL %,%1,%2,%3,%DT,F,M,V,W,X,Y,Z
+3 KILL ACD3PDAT,ACD3PO,ACDMODE,ACDBDATE,ACDDTLO,ACDDTHI,ACDBIEN,ACDDFNP,ACDFILE,ACDRPR,ACDVIEN,ACDCSIEN,ACD3PCOV
+4 QUIT
