- 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 Jan 18, 2025@03:08:50 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