- 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
