- 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
