IBARXMP ;LL/ELZ - PHARMCAY COPAY CAP PUSH TRANSACTION ;26-APR-2001
;;2.0;INTEGRATED BILLING;**150,158,637,676**;21-MAR-94;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
PUSH ; this entry point will allow the user to select one or all transactions
; and transmit them to other treating facilities. This is used to try
; to resolve untransmitted transactions. First IRM should verify the
; HL7 link is working properly.
;
N DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBER
;
W !!,"This option will attempt to transmit un-transmitted copay cap transactions.",!,"You can select to send all un-transmitted transactions or selected"
W !,"individual transactions. If you choose All, it could tie up your terminal",!,"session for some time.",!
S DIR(0)="S^A:All;I:Individual",DIR("A")="Do you want to transmit All or Individual transactions" D ^DIR Q:$D(DIRUT)
;
D @Y
Q
I ; transmits selected individual transactions
N DIC,X,Y,IBZ,IBX,%,%Y,IBTFL,DFN,IBY,IBS,IBONE
;
S DIC="^IBAM(354.71,",DIC(0)="AEMNQZ",IBS=+$P($$SITE^IBARXMU,"^",3),DIC("S")="I $E(^(0),1,3)=IBS" D ^DIC Q:Y<1
S IBX=+Y,IBZ=Y(0),DFN=$P(IBZ,"^",2),IBTFL=$$TFL^IBARXMU(DFN,.IBTFL,2),IBY=1
;
I IBTFL,($P(IBZ,"^",5)="C"!($P(IBZ,"^",5)="X")) W !!,"This transaction appears to already be transmitted.",!,"Do you want to transmit again" S %=2 D YN^DICN G:%'=1 I S IBONE=1
;
I 'IBTFL W !!,"The patient for this transaction has no treating facilities to transmit to." D STATUS^IBARXMA(.IBY,IBX,0) G I
;
D FOUND^IBARXMA(.IBY,IBX)
;
U IO
I '$D(IBER) W !,"Transmission Successful !!",!
I $D(IBER) S X=0 F S X=$O(IBER(X)) Q:'X W !,"Error: ",X,"=",IBER(X)
W ! K IBER
;
G I
A ; transmits all un-transmitted transactions
N IBX,IBS
;
I '$D(^IBAM(354.71,"AC","P")),'$D(^("Y")) W !!,"No Un-transmitted records to send.",!! Q
;
F IBS="P","Y" S IBX=0 F S IBX=$O(^IBAM(354.71,"AC",IBS,IBX)) Q:IBX<1 D
. N IBER,IBY,IBZ,DFN
. S IBY=1,IBZ=$G(^IBAM(354.71,IBX,0)) Q:IBZ=""
. S DFN=$P(IBZ,"^",2)
. W !,"Now transmitting ",$P(IBZ,"^")
. D FOUND^IBARXMA(.IBY,IBX)
. U IO
. I '$D(IBER) W !,"Transmission Successful !!",! Q
. I $D(IBER) S X=0 F S X=$O(IBER(X)) Q:'X W !,"Error: ",IBER(X)
. W ! K IBER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXMP 2252 printed Dec 13, 2024@02:07:37 Page 2
IBARXMP ;LL/ELZ - PHARMCAY COPAY CAP PUSH TRANSACTION ;26-APR-2001
+1 ;;2.0;INTEGRATED BILLING;**150,158,637,676**;21-MAR-94;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
PUSH ; this entry point will allow the user to select one or all transactions
+1 ; and transmit them to other treating facilities. This is used to try
+2 ; to resolve untransmitted transactions. First IRM should verify the
+3 ; HL7 link is working properly.
+4 ;
+5 NEW DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,IBER
+6 ;
+7 WRITE !!,"This option will attempt to transmit un-transmitted copay cap transactions.",!,"You can select to send all un-transmitted transactions or selected"
+8 WRITE !,"individual transactions. If you choose All, it could tie up your terminal",!,"session for some time.",!
+9 SET DIR(0)="S^A:All;I:Individual"
SET DIR("A")="Do you want to transmit All or Individual transactions"
DO ^DIR
if $DATA(DIRUT)
QUIT
+10 ;
+11 DO @Y
+12 QUIT
I ; transmits selected individual transactions
+1 NEW DIC,X,Y,IBZ,IBX,%,%Y,IBTFL,DFN,IBY,IBS,IBONE
+2 ;
+3 SET DIC="^IBAM(354.71,"
SET DIC(0)="AEMNQZ"
SET IBS=+$PIECE($$SITE^IBARXMU,"^",3)
SET DIC("S")="I $E(^(0),1,3)=IBS"
DO ^DIC
if Y<1
QUIT
+4 SET IBX=+Y
SET IBZ=Y(0)
SET DFN=$PIECE(IBZ,"^",2)
SET IBTFL=$$TFL^IBARXMU(DFN,.IBTFL,2)
SET IBY=1
+5 ;
+6 IF IBTFL
IF ($PIECE(IBZ,"^",5)="C"!($PIECE(IBZ,"^",5)="X"))
WRITE !!,"This transaction appears to already be transmitted.",!,"Do you want to transmit again"
SET %=2
DO YN^DICN
if %'=1
GOTO I
SET IBONE=1
+7 ;
+8 IF 'IBTFL
WRITE !!,"The patient for this transaction has no treating facilities to transmit to."
DO STATUS^IBARXMA(.IBY,IBX,0)
GOTO I
+9 ;
+10 DO FOUND^IBARXMA(.IBY,IBX)
+11 ;
+12 USE IO
+13 IF '$DATA(IBER)
WRITE !,"Transmission Successful !!",!
+14 IF $DATA(IBER)
SET X=0
FOR
SET X=$ORDER(IBER(X))
if 'X
QUIT
WRITE !,"Error: ",X,"=",IBER(X)
+15 WRITE !
KILL IBER
+16 ;
+17 GOTO I
A ; transmits all un-transmitted transactions
+1 NEW IBX,IBS
+2 ;
+3 IF '$DATA(^IBAM(354.71,"AC","P"))
IF '$DATA(^("Y"))
WRITE !!,"No Un-transmitted records to send.",!!
QUIT
+4 ;
+5 FOR IBS="P","Y"
SET IBX=0
FOR
SET IBX=$ORDER(^IBAM(354.71,"AC",IBS,IBX))
if IBX<1
QUIT
Begin DoDot:1
+6 NEW IBER,IBY,IBZ,DFN
+7 SET IBY=1
SET IBZ=$GET(^IBAM(354.71,IBX,0))
if IBZ=""
QUIT
+8 SET DFN=$PIECE(IBZ,"^",2)
+9 WRITE !,"Now transmitting ",$PIECE(IBZ,"^")
+10 DO FOUND^IBARXMA(.IBY,IBX)
+11 USE IO
+12 IF '$DATA(IBER)
WRITE !,"Transmission Successful !!",!
QUIT
+13 IF $DATA(IBER)
SET X=0
FOR
SET X=$ORDER(IBER(X))
if 'X
QUIT
WRITE !,"Error: ",IBER(X)
+14 WRITE !
KILL IBER
End DoDot:1
+15 QUIT
