Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCF

IBCF.m

Go to the documentation of this file.
  1. IBCF ;ALB/RLW - task 1500/UB printing ;12-JUN-92
  1. ;;2.0;INTEGRATED BILLING;**33,63,52,121,51,137,349,641**;21-MAR-94;Build 61
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN1(IBABORT) ; call appropriate print routine for the claim form type to be printed ;WCJ;US3380;ADDED IBABORT
  1. K IBRESUB
  1. G EN1TAG ;WCJ;US3380;added GOTO;you think of a better way
  1. ;
  1. EN1X(IBABORT) ; Entrypoint for reprint (IBRESUB will be defined);WCJ;US3380;added parameter
  1. ;
  1. EN1TAG N IBF,IB,IBFORM,IBJ ;WCJ;US3380; added tag;you think of a better way
  1. S IB=$$FT^IBCU3(IBIFN) ; form type ien (2 or 3)
  1. S IBFT=$$FTN^IBCU3(IB) ; form type name
  1. S IBF=$P($G(^IBE(353,+IB,2)),U,8)
  1. S:IBF="" IBF=IB ;Forces the use of the output formatter to print bills
  1. D ENFMT(IBIFN,IB,IBF,,$G(IBRESUB),.IBABORT) ;WCJ;US3380;ADDED IBABORT
  1. END K IBFT,IBRESUB
  1. Q
  1. ;
  1. EN2 ; send to default A/R device
  1. S ZTDTH=$H,IBIFN=PRCASV("ARREC"),IBPNT=PRCASV("NOTICE")
  1. D FORM S (IBFORM1,ZTDESC)="FOLLOW-UP AR FORM "_$P($G(^IBE(353,+IBFT,0)),"^")
  1. D QUEUE
  1. Q
  1. ;
  1. EN3 ;queue an Rx Addendum for a bill, IBIFN must be defined
  1. Q:'$D(^DGCR(399,+$G(IBIFN),0)) I '$D(^IBA(362.4,"AIFN"_+IBIFN)),'$D(^IBA(362.5,"AIFN"_+IBIFN)) Q
  1. N IBFT S IBFT=$$FNT^IBCU3("BILL ADDENDUM") Q:'IBFT S (IBFORM1,ZTDESC)="BILL ADDENDUM FOR "_$P(^DGCR(399,+IBIFN,0),U,1)
  1. S ZTSAVE("IB*")="",ZTDTH=$H
  1. S ZTIO=$P($G(^IBE(353,IBFT,0)),"^",2),ZTRTN=$G(^IBE(353,IBFT,1)) I (ZTIO="")!(ZTRTN="") K ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN Q
  1. D ^%ZTLOAD
  1. Q
  1. ;
  1. EN4 ;queue bills, IBIFN must be defined
  1. S ZTDTH=$H,IBPNT=1 Q:'$D(^DGCR(399,+$G(IBIFN),0))
  1. D FORM
  1. S IBF=$P($G(^IBE(353,+IBFT,2)),U,8)
  1. I $P($G(^IBE(353,+IBFT,0)),U,2)="",IBF="" Q
  1. S (IBFORM1,ZTDESC)=$P($G(^IBE(353,+IBFT,0)),"^")_" BILL "_$P(^DGCR(399,+IBIFN,0),U,1)
  1. S ZTSAVE("IB*")=""
  1. S ZTIO=$P($G(^IBE(353,IBFT,0)),"^",2),ZTRTN=$S(IBF="":$G(^IBE(353,IBFT,1)),1:"ENFMT^IBCF(IBIFN,IBFT,IBF,ZTIO,$G(IBRESUB))")
  1. I (ZTIO="")!(ZTRTN="") S IBAR("ERR")="BILL FORM TYPE NOT COMPLETE FOR"_IBFORM1 Q
  1. D ^%ZTLOAD I '$D(ZTSK) S IBAR("ERR")="QUEUEING OF "_IBFORM1_" FAILED",IBAR("OKAY")=0 W IBAR("ERR") Q
  1. S IBAR("OKAY")=1
  1. Q
  1. ;
  1. EN5 ;queue 1500 Rx Addendum to Follow-up (AR) printer, IBIFN must be defined - no longer used
  1. Q:'$D(^DGCR(399,+$G(IBIFN),0)) I '$D(^IBA(362.4,"AIFN"_+IBIFN)),'$D(^IBA(362.5,"AIFN"_+IBIFN)) Q
  1. Q:$$FT^IBCU3(IBIFN)'=2
  1. N IBFT S IBFT=$$FNT^IBCU3("BILL ADDENDUM") Q:'IBFT S (IBFORM1,ZTDESC)="BILL ADDENDUM FOR "_$P(^DGCR(399,+IBIFN,0),U,1)
  1. S ZTSAVE("IB*")="",ZTDTH=$H
  1. S ZTIO=$P($G(^IBE(353,IBFT,0)),"^",3),ZTRTN=$G(^IBE(353,IBFT,1)) I (ZTIO="")!(ZTRTN="") K ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN Q
  1. D ^%ZTLOAD
  1. Q
  1. ;
  1. ENFMT(IBIFN,IB,IBF,ZTIO,IBRESUB,IBABORT) ; Use formatter to print bill IBIFN
  1. ; WCJ;USS3380;added IBABORT which will be set to 1 if they went in to print but dint
  1. N IBFT,IBFTP,IBFORM,IBJ
  1. S (IBFT,IBFORM)=IB,IBFTP="IBCFP"_IB,IBJ=$J
  1. K ^XTMP(IBFTP,$J),^TMP("IBQONE",$J)
  1. S ^XTMP(IBFTP,$J,1,1,1,IBIFN)="",^TMP("IBQONE",$J)=""
  1. ;D FORM^IBCEFG7(IBF,$G(ZTIO)) ;WCJ;US3380
  1. D FORM^IBCEFG7(IBF,$G(ZTIO),,,,.IBABORT) ;WCJ;US3380;ADDED IBABORT
  1. I $G(IBRESUB) D
  1. . N IBDA
  1. . S IBDA=$$LAST364^IBCEF4(IBIFN)
  1. . I IBDA D UPDEDI^IBCEM(IBDA,"P")
  1. K ^TMP("IBQONE",$J)
  1. I IBFT'=3 D EN3
  1. Q
  1. ;
  1. FORM ;
  1. S IBFT=$$FT^IBCU3(IBIFN)
  1. Q
  1. QUEUE ;
  1. S IBF=$P($G(^IBE(353,+IBFT,2)),U,8)
  1. S ZTSAVE("IB*")=""
  1. S ZTIO=$P($G(^IBE(353,IBFT,0)),"^",3),ZTRTN=$S(IBF="":$G(^IBE(353,IBFT,1)),1:"ENFMT^IBCF(IBIFN,IBFT,IBF,ZTIO,$G(IBRESUB))")
  1. I ((ZTIO="")&(IBF=""))!(ZTRTN="") S IBAR("ERR")="BILL FORM TYPE NOT COMPLETE FOR"_IBFORM1 Q
  1. D ^%ZTLOAD I '$D(ZTSK) S IBAR("ERR")="QUEUEING OF "_IBFORM1_" FAILED",IBAR("OKAY")=0 W IBAR("ERR") Q
  1. S IBAR("OKAY")=1
  1. Q
  1. ;
  1. DISPX ; call to exclude transmittable bills
  1. D DISP1(1)
  1. Q
  1. ;
  1. DISP ; call to include all bills
  1. D DISP1(0)
  1. Q
  1. ;
  1. DISP1(IBTX) ;print list of authorized bills - exclude transmittables if
  1. ; IBTX=1
  1. N IBIFN,IBC,Y
  1. S IBIFN=0,IBC=0,Y="" W !
  1. F S IBIFN=$O(^DGCR(399,"AST",3,IBIFN)) Q:'IBIFN S IBX=$G(^DGCR(399,IBIFN,0)) I IBX'="" D Q:Y="^"
  1. . I $G(IBTX) D Q:IBX=""
  1. .. N Z
  1. .. S Z=0 F S Z=$O(^IBA(364,"B",IBIFN,Z)) Q:'Z I $D(^IBA(364,"ASTAT","X",Z)) S IBX="" Q
  1. . 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")
  1. . 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)
  1. . S IBC=IBC+1 I '(IBC#10) R !,"Press RETURN to continue or '^' to exit: ",Y:DTIME
  1. Q
  1. ;
  1. DISPT ;print list of all bills awaiting transmission
  1. N IBI,IBIFN,IBC,Y S (IBC,IBI)=0,Y="" W !
  1. F S IBI=$O(^IBA(364,"ASTAT","X",IBI)) Q:'IBI S IBIFN=+$G(^IBA(364,+IBI,0)),IBX=$G(^DGCR(399,IBIFN,0)) I IBX'="" D Q:Y="^"
  1. . 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")
  1. . 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)
  1. . S IBC=IBC+1 I '(IBC#10) R !,"Press RETURN to continue or '^' to exit: ",Y:DTIME
  1. Q
  1. ;