IBCF ;ALB/RLW - task HCFA 1500 ; 12-JUN-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN1 ; call appropriate print routine for the claim form type to be printed
;S IBFT=+$P($G(^DGCR(399,IBIFN,0)),U,19)
;I IBFT=2 D ^IBCF2 G END
;D ^IBCF1
S IBFT=$$FT^IBCU3(IBIFN),IBFT=$$FTN^IBCU3(IBFT)
I IBFT["UB-82" D ^IBCF1 G END
I IBFT["UB-92" D ^IBCF3 G END
D ^IBCF2 D EN3
END K IBFT
Q
;
EN2 ; send to default A/R device
S ZTDTH=$H,IBIFN=PRCASV("ARREC"),IBPNT=PRCASV("NOTICE")
D FORM S (IBFORM1,ZTDESC)="FOLLOW-UP AR FORM "_$P($G(^IBE(353,+IBFT,0)),"^")
D QUEUE
Q
;
EN3 ;queue an Rx Addendum for a bill, IBIFN must be defined
Q:'$D(^DGCR(399,+$G(IBIFN),0)) I '$D(^IBA(362.4,"AIFN"_+IBIFN)),'$D(^IBA(362.5,"AIFN"_+IBIFN)) Q
N IBFT S IBFT=$$FNT^IBCU3("BILL ADDENDUM") Q:'IBFT S (IBFORM1,ZTDESC)="BILL ADDENDUM FOR "_$P(^DGCR(399,+IBIFN,0),U,1)
S ZTSAVE("IB*")="",ZTDTH=$H
S ZTIO=$P($G(^IBE(353,IBFT,0)),"^",2),ZTRTN=$G(^IBE(353,IBFT,1)) Q:(ZTIO="")!(ZTRTN="")
D ^%ZTLOAD
Q
;
EN4 ;queue bills, IBIFN must be defined
S ZTDTH=$H,IBPNT=1 Q:'$D(^DGCR(399,+$G(IBIFN),0))
D FORM I $P($G(^IBE(353,+IBFT,0)),U,2)="" Q
S (IBFORM1,ZTDESC)=$P($G(^IBE(353,+IBFT,0)),"^")_" BILL "_$P(^DGCR(399,+IBIFN,0),U,1)
S ZTSAVE("IB*")="",ZTSAVE("IB*")=""
S ZTIO=$P($G(^IBE(353,IBFT,0)),"^",2),ZTRTN=$G(^IBE(353,IBFT,1))
I (ZTIO="")!(ZTRTN="") S IBAR("ERR")="BILL FORM TYPE NOT COMPLETE FOR"_IBFORM1 Q
D ^%ZTLOAD I '$D(ZTSK) S IBAR("ERR")="QUEUEING OF "_IBFORM1_" FAILED",IBAR("OKAY")=0 W IBAR("ERR") Q
S IBAR("OKAY")=1
Q
FORM ;
;S IBFT=$P($G(^DGCR(399,IBIFN,0)),"^",19)
S IBFT=$$FT^IBCU3(IBIFN)
Q
QUEUE ;
S ZTSAVE("IB*")="",ZTSAVE("IB*")=""
S ZTIO=$P($G(^IBE(353,IBFT,0)),"^",3),ZTRTN=$G(^IBE(353,IBFT,1))
I (ZTIO="")!(ZTRTN="") S IBAR("ERR")="BILL FORM TYPE NOT COMPLETE FOR"_IBFORM1 Q
D ^%ZTLOAD I '$D(ZTSK) S IBAR("ERR")="QUEUEING OF "_IBFORM1_" FAILED",IBAR("OKAY")=0 W IBAR("ERR") Q
S IBAR("OKAY")=1
Q
;
DISP ;print list of all authorized bills
N IBIFN,IBC,Y S IBIFN=0,IBC=0,Y="" W !
F S IBIFN=$O(^DGCR(399,"AST",3,IBIFN)) Q:'IBIFN S IBX=$G(^DGCR(399,IBIFN,0)) I IBX'="" D Q:Y="^"
. W !,$P(IBX,U,1),?10,$E($P($G(^DPT(+$P(IBX,U,2),0)),U,1),1,20),?32,$$DATE^IBCFP(+$P(IBX,U,3)),?42,$S(+$P(IBX,U,5)<3:"INPT",1:"OUTPT")
. W ?49,$P($G(^DGCR(399.3,+$P(IBX,U,7),0)),U,4),?59,$E($$EXSET^IBEFUNC(+$P(IBX,U,13),399,.13),1,7),?68,$E($$FTN^IBCU3($$FT^IBCU3(IBIFN)),1,11)
. S IBC=IBC+1 I '(IBC#10) R !,"Press RETURN to continue or '^' to exit: ",Y:DTIME
Q
IBCF ;ALB/RLW - task HCFA 1500 ; 12-JUN-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN1 ; call appropriate print routine for the claim form type to be printed
+1 ;S IBFT=+$P($G(^DGCR(399,IBIFN,0)),U,19)
+2 ;I IBFT=2 D ^IBCF2 G END
+3 ;D ^IBCF1
+4 SET IBFT=$$FT^IBCU3(IBIFN)
SET IBFT=$$FTN^IBCU3(IBFT)
+5 IF IBFT["UB-82"
DO ^IBCF1
GOTO END
+6 IF IBFT["UB-92"
DO ^IBCF3
GOTO END
+7 DO ^IBCF2
DO EN3
END KILL IBFT
+1 QUIT
+2 ;
EN2 ; send to default A/R device
+1 SET ZTDTH=$HOROLOG
SET IBIFN=PRCASV("ARREC")
SET IBPNT=PRCASV("NOTICE")
+2 DO FORM
SET (IBFORM1,ZTDESC)="FOLLOW-UP AR FORM "_$PIECE($GET(^IBE(353,+IBFT,0)),"^")
+3 DO QUEUE
+4 QUIT
+5 ;
EN3 ;queue an Rx Addendum for a bill, IBIFN must be defined
+1 IF '$DATA(^DGCR(399,+$GET(IBIFN),0))
QUIT
IF '$DATA(^IBA(362.4,"AIFN"_+IBIFN))
IF '$DATA(^IBA(362.5,"AIFN"_+IBIFN))
QUIT
+2 NEW IBFT
SET IBFT=$$FNT^IBCU3("BILL ADDENDUM")
IF 'IBFT
QUIT
SET (IBFORM1,ZTDESC)="BILL ADDENDUM FOR "_$PIECE(^DGCR(399,+IBIFN,0),U,1)
+3 SET ZTSAVE("IB*")=""
SET ZTDTH=$HOROLOG
+4 SET ZTIO=$PIECE($GET(^IBE(353,IBFT,0)),"^",2)
SET ZTRTN=$GET(^IBE(353,IBFT,1))
IF (ZTIO="")!(ZTRTN="")
QUIT
+5 DO ^%ZTLOAD
+6 QUIT
+7 ;
EN4 ;queue bills, IBIFN must be defined
+1 SET ZTDTH=$HOROLOG
SET IBPNT=1
IF '$DATA(^DGCR(399,+$GET(IBIFN),0))
QUIT
+2 DO FORM
IF $PIECE($GET(^IBE(353,+IBFT,0)),U,2)=""
QUIT
+3 SET (IBFORM1,ZTDESC)=$PIECE($GET(^IBE(353,+IBFT,0)),"^")_" BILL "_$PIECE(^DGCR(399,+IBIFN,0),U,1)
+4 SET ZTSAVE("IB*")=""
SET ZTSAVE("IB*")=""
+5 SET ZTIO=$PIECE($GET(^IBE(353,IBFT,0)),"^",2)
SET ZTRTN=$GET(^IBE(353,IBFT,1))
+6 IF (ZTIO="")!(ZTRTN="")
SET IBAR("ERR")="BILL FORM TYPE NOT COMPLETE FOR"_IBFORM1
QUIT
+7 DO ^%ZTLOAD
IF '$DATA(ZTSK)
SET IBAR("ERR")="QUEUEING OF "_IBFORM1_" FAILED"
SET IBAR("OKAY")=0
WRITE IBAR("ERR")
QUIT
+8 SET IBAR("OKAY")=1
+9 QUIT
FORM ;
+1 ;S IBFT=$P($G(^DGCR(399,IBIFN,0)),"^",19)
+2 SET IBFT=$$FT^IBCU3(IBIFN)
+3 QUIT
QUEUE ;
+1 SET ZTSAVE("IB*")=""
SET ZTSAVE("IB*")=""
+2 SET ZTIO=$PIECE($GET(^IBE(353,IBFT,0)),"^",3)
SET ZTRTN=$GET(^IBE(353,IBFT,1))
+3 IF (ZTIO="")!(ZTRTN="")
SET IBAR("ERR")="BILL FORM TYPE NOT COMPLETE FOR"_IBFORM1
QUIT
+4 DO ^%ZTLOAD
IF '$DATA(ZTSK)
SET IBAR("ERR")="QUEUEING OF "_IBFORM1_" FAILED"
SET IBAR("OKAY")=0
WRITE IBAR("ERR")
QUIT
+5 SET IBAR("OKAY")=1
+6 QUIT
+7 ;
DISP ;print list of all authorized bills
+1 NEW IBIFN,IBC,Y
SET IBIFN=0
SET IBC=0
SET Y=""
WRITE !
+2 FOR
SET IBIFN=$ORDER(^DGCR(399,"AST",3,IBIFN))
IF 'IBIFN
QUIT
SET IBX=$GET(^DGCR(399,IBIFN,0))
IF IBX'=""
Begin DoDot:1
+3 WRITE !,$PIECE(IBX,U,1),?10,$EXTRACT($PIECE($GET(^DPT(+$PIECE(IBX,U,2),0)),U,1),1,20),?32,$$DATE^IBCFP(+$PIECE(IBX,U,3)),?42,$SELECT(+$PIECE(IBX,U,5)<3:"INPT",1:"OUTPT")
+4 WRITE ?49,$PIECE($GET(^DGCR(399.3,+$PIECE(IBX,U,7),0)),U,4),?59,$EXTRACT($$EXSET^IBEFUNC(+$PIECE(IBX,U,13),399,.13),1,7),?68,$EXTRACT($$FTN^IBCU3($$FT^IBCU3(IBIFN)),1,11)
+5 SET IBC=IBC+1
IF '(IBC#10)
READ !,"Press RETURN to continue or '^' to exit: ",Y:DTIME
End DoDot:1
IF Y="^"
QUIT
+6 QUIT
