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

IBARXMA.m

Go to the documentation of this file.
  1. IBARXMA ;LL/ELZ - PHARMCAY COPAY BACKGROUND PROCESSES ; 02 Mar 2021
  1. ;;2.0;INTEGRATED BILLING;**150,158,676**;21-MAR-94;Build 34
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. FILER(IBA) ; This label is called by the IB background filer to
  1. ; notify other facilities that a transaction has occurred on the current
  1. ; facility. It will then update the status in 354.71 assuming that the
  1. ; transaction was accepted at all the subscribing facilities.
  1. ;
  1. ; IBA would be the IEN of file 350 to process.
  1. ;
  1. N IBZ,IBY,Y,IBER
  1. ;
  1. S IBZ=$P($G(^IB(+IBA,0)),"^",19) I 'IBZ Q
  1. S $P(^IBAM(354.71,IBZ,0),"^",4)=+IBA ; set reference back
  1. ;
  1. S IBY=1 D FOUND(.IBY,IBZ)
  1. ;
  1. I -1=+$G(IBY) S Y=IBY D ^IBAERR
  1. ;
  1. Q
  1. ;
  1. FOUND(IBY,IBZ) ; come in here to do the work
  1. ;
  1. ; ien in 354.71 stored in IBZ, assumes DFN is defined
  1. ;
  1. N IBTFL,IBX,IBT,X,Y,DIE,DA,DR,DIC,IBS,IBD
  1. ;
  1. ; get treating facility list
  1. S IBTFL=$$TFL^IBARXMU(DFN,.IBTFL,2)
  1. ;
  1. ; No other facilities, I'm done
  1. I 'IBTFL D STATUS(.IBY,IBZ,0) Q
  1. ;
  1. ; ok lets do some talking to other VA's
  1. S IBX=0 F S IBX=$O(IBTFL(IBX)) Q:IBX<1!(IBY<1) D
  1. . ;
  1. . ; have I already completed transmission here?
  1. . S IBS=$$LKUP^XUAF4($P(IBTFL(IBX),"^")) ;676;BL Modify the call to use full station number
  1. . I IBS>0,$P($G(^IBAM(354.71,IBZ,1,+$O(^IBAM(354.71,IBZ,1,"B",+IBS,0)),0)),"^",2),'$G(IBONE) Q
  1. . ;
  1. . I '$D(ZTQUEUED) U IO W !,"Now transmitting to ",$P(IBTFL(IBX),"^",2)," ..."
  1. . D ;Determine if Cerner, use HL7 send
  1. . . I $P(IBTFL(IBX),"^",1)["200CRNR" D Q
  1. . . . D EN^IBARXCHL(DFN,IBZ)
  1. . . . S IBT=1 ;Assume send was successful
  1. . . S IBT=$$SEND^IBARXMU(DFN,IBX,^IBAM(354.71,IBZ,0))
  1. . ;
  1. . ; update 354.71 transmission record
  1. . S DA=$O(^IBAM(354.71,IBZ,1,"B",IBS,0)),DA(1)=IBZ
  1. . ;
  1. . ; save of error(s) for message
  1. . S:IBT<1 IBER(IBX)=IBT
  1. . ;
  1. . I DA D Q
  1. .. S DIE="^IBAM(354.71,"_IBZ_",1,",DR=".02////"_$S(+IBT>0:1,1:0)
  1. .. L +^IBAM(354.71,IBZ,1,DA):10 I '$T S IBY="-1^IB318" Q
  1. .. D ^DIE L -^IBAM(354.71,IBZ,1,DA)
  1. . S DIC="^IBAM(354.71,"_IBZ_",1,",DIC(0)="",X=IBS
  1. . S DIC("DR")=".02////"_$S(IBT>0:1,1:0) D FILE^DICN
  1. ;
  1. D STATUS(.IBY,IBZ,IBTFL):IBY>0
  1. ;
  1. Q
  1. ;
  1. NIGHT ; queue off job to do nightly processing
  1. N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
  1. S ZTIO="",ZTRTN="NIGHTQ^IBARXMA",ZTDTH=$H,ZTDESC="RX Copay Cap Follow-up Transmissions"
  1. D ^%ZTLOAD
  1. Q
  1. ;
  1. NIGHTQ ; called from nightly background job for transmissions
  1. ;
  1. N IBX,IBS,X
  1. ;
  1. F IBS="P","Y" S IBX=0 F S IBX=$O(^IBAM(354.71,"AC",IBS,IBX)) Q:IBX<1 D
  1. . N IBY,IBZ,IBM,XMZ,XMY,XMDUZ,XMSUB,IBL,IBF,IBT,DFN,IBA,IBN,IBER S IBY=1
  1. . ;
  1. . S DFN=$P($G(^IBAM(354.71,+IBX,0)),"^",2) Q:'DFN
  1. . S IBY=1 D FOUND(.IBY,IBX)
  1. . ;
  1. . ; if it is successful, quit and move on to next one
  1. . S IBZ=^IBAM(354.71,IBX,0)
  1. . I IBY>0,($P(IBZ,"^",5)="C"!($P(IBZ,"^",5)="X")) Q
  1. . ;
  1. . ; is the transaction < 2 days old, quit
  1. . I $$FMADD^XLFDT($P(IBZ,"^",15),2)>DT Q
  1. . ;
  1. . ; send message to mail group of old transaction notification
  1. . D DEM^VADPT
  1. . S XMSUB="Rx Copay Transmission Error",XMDUZ="INTEGRATED BILLING PACKAGE" D XMZ^XMA2 I XMZ<1 Q
  1. . S IBL=0
  1. . D M("A medication co-payment transaction could not be sent to one or more of"),M("the patient's treating facilities for at least 2 days. After verifying that")
  1. . D M("the HL7 Logical Links are working correctly to the sites listed below, you"),M("can use the option 'Push Rx Copay Cap Transactions' to transmit this")
  1. . D M("transaction immediately or the IB software will try to transmit this"),M("transaction when the IB MT NIGHT COMP job runs.")
  1. . D M(" "),M(" Patient: "_VADM(1)),M(" SSN: "_VA("PID")),M("Transaction: "_$P(IBZ,"^")),M(" ")
  1. . D M("Facility Status"),M("----------------------------------- --------------------")
  1. . S IBF=0 F S IBF=$O(^IBAM(354.71,IBX,1,IBF)) Q:IBF<1 S IBT=^IBAM(354.71,IBX,1,IBF,0),IBN=$$FAC^IBARXMU(+IBT),IBN=$P(IBN,"^")_" ("_$P(IBN,"^",2)_")" D
  1. .. D M($$SP(IBN,39)_$$EXTERNAL^DILFD(354.711,.02,"",$P(IBT,"^",2)))
  1. . ;
  1. . ; include errors in message
  1. . I $D(IBER) D M(" "),M("Errors:") S X=0 F S X=$O(IBER(X)) Q:X<1 D M(X_" = "_IBER(X))
  1. . ;
  1. . S ^XMB(3.9,XMZ,2,0)="^3.92^"_IBL_"^"_IBL_"^"_DT
  1. . S XMY("G.IB RX COPAY CAP ERROR")=""
  1. . D ENT1^XMD
  1. Q
  1. ;
  1. SP(X,Y) ; makes X be Y space long
  1. F Q:$L(X)>(Y-1) S X=X_" "
  1. Q $E(X,1,Y)
  1. ;
  1. STATUS(IBY,IBZ,IBT) ; update status in 354.71 if applicable
  1. ; IBY is return error if applicable
  1. ; IBZ is the entry number in 354.71
  1. ; IBT indicates number of treating facilities
  1. ;
  1. N IBS,IBX,DA,DIE,DR,X,Y,IBD
  1. ;
  1. S IBS=1,IBX=0 I IBT F S IBX=$O(^IBAM(354.71,IBZ,1,IBX)) Q:IBX<1 S:$P(^IBAM(354.71,IBZ,1,IBX,0),"^",2)'=1 IBS=0
  1. ;
  1. I IBS S IBD=$P(^IBAM(354.71,IBZ,0),"^",5) D
  1. . S DIE="^IBAM(354.71,",DA=IBZ
  1. . S DR=".05///"_$S(IBD="Y":"X",IBD="X":IBD,1:"C")
  1. . L +^IBAM(354.71,IBZ):10 I '$T S IBY="-1^IB318" Q
  1. . D ^DIE L -^IBAM(354.71,IBZ)
  1. ;
  1. I $G(IBY)<1 S IBY=1 ; success flag
  1. ;
  1. Q
  1. M(T) ; used to set text in mail message
  1. ; assumes XMZ and IBL
  1. S IBL=IBL+1,^XMB(3.9,XMZ,2,IBL,0)=T
  1. ;