- FBAARR2 ;AISC/GRR - REINITIATE REJECTED LINE ITEMS ;3/27/2012
- ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- DELT ;TRAVEL LINE ITEM RE-INITIATE
- ; select patient
- S J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AG"",B,+Y))")
- Q:'J
- K QQ
- S QQ=0 W @IOF D HEDP^FBAACCB0
- F K=0:0 S K=$O(^FBAAC("AG",B,J,K)) Q:K'>0 S QQ=QQ+1,QQ(QQ)=J_"^"_K S Y(0)=^FBAAC(J,3,K,0) D SETT^FBAACCB0
- RLT S DIR(0)="N^1:"_QQ,DIR("A")="Re-initiate which line item" D ^DIR K DIR G:$D(DIRUT) ENDT S HX=X
- I '$D(QQ(HX)) W !!,*7,"You just did that one!!" G RLT
- RIN S DIR(0)="Y",DIR("A")="Are you sure you want to re-initiate line item number: "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RLT
- S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2)
- K FBERR
- D REJT^FBAARR1
- K QQ(HX)
- RASK S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Line Re-initiated. ")_"Want to re-initiate another",DIR("B")="YES" D ^DIR K DIR G RASK:$D(DIRUT),ENDT:'Y,DELT:Y
- ENDT ;
- Q
- DELP ;PHARMACY LINE ITEM RE-INITIATE
- RDI W !! S DIC="^FBAA(162.1,",DIC(0)="AEQ" D ^DIC Q:X="^"!(X="") G:Y<0 RDI S A=+Y I '$D(^FBAA(162.1,"AF",B,A)) W !!,*7,"No payments rejected in this batch for that Invoice!" G RDI
- K QQ
- S QQ=0,FBIN=A W @IOF D SETV^FBAACCB0,HED^FBAACCB
- F B2=0:0 S B2=$O(^FBAA(162.1,"AF",B,A,B2)) Q:B2'>0 S QQ=QQ+1,QQ(QQ)=A_"^"_B2 S Z(0)=^FBAA(162.1,A,"RX",B2,0) D MORE^FBAACCB1
- RLP S DIR(0)="N^1:"_QQ,DIR("A")="Re-initiate which line item" D ^DIR K DIR G:$D(DIRUT) ENDP S HX=X
- I '$D(QQ(HX)) W !!,*7,"You just did that one!!" G RLP
- PRIN S DIR(0)="Y",DIR("A")="Are you sure you want to re-initiate item number: "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RLP
- S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2)
- K FBERR
- D REJP^FBAARR1
- PASK S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Line Re-initiated. ")_"Want to re-initiate another",DIR("B")="YES" D ^DIR K DIR G PASK:$D(DIRUT),DELP:Y,ENDP
- ENDP ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAARR2 1915 printed Feb 18, 2025@23:22:57 Page 2
- FBAARR2 ;AISC/GRR - REINITIATE REJECTED LINE ITEMS ;3/27/2012
- +1 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- DELT ;TRAVEL LINE ITEM RE-INITIATE
- +1 ; select patient
- +2 SET J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AG"",B,+Y))")
- +3 if 'J
- QUIT
- +4 KILL QQ
- +5 SET QQ=0
- WRITE @IOF
- DO HEDP^FBAACCB0
- +6 FOR K=0:0
- SET K=$ORDER(^FBAAC("AG",B,J,K))
- if K'>0
- QUIT
- SET QQ=QQ+1
- SET QQ(QQ)=J_"^"_K
- SET Y(0)=^FBAAC(J,3,K,0)
- DO SETT^FBAACCB0
- RLT SET DIR(0)="N^1:"_QQ
- SET DIR("A")="Re-initiate which line item"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO ENDT
- SET HX=X
- +1 IF '$DATA(QQ(HX))
- WRITE !!,*7,"You just did that one!!"
- GOTO RLT
- RIN SET DIR(0)="Y"
- SET DIR("A")="Are you sure you want to re-initiate line item number: "_HX
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!'Y
- GOTO RLT
- +1 SET J=$PIECE(QQ(HX),"^",1)
- SET K=$PIECE(QQ(HX),"^",2)
- +2 KILL FBERR
- +3 DO REJT^FBAARR1
- +4 KILL QQ(HX)
- RASK SET DIR(0)="Y"
- SET DIR("A")=$SELECT($GET(FBERR):"",1:"Line Re-initiated. ")_"Want to re-initiate another"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO RASK
- if 'Y
- GOTO ENDT
- if Y
- GOTO DELT
- ENDT ;
- +1 QUIT
- DELP ;PHARMACY LINE ITEM RE-INITIATE
- RDI WRITE !!
- SET DIC="^FBAA(162.1,"
- SET DIC(0)="AEQ"
- DO ^DIC
- if X="^"!(X="")
- QUIT
- if Y<0
- GOTO RDI
- SET A=+Y
- IF '$DATA(^FBAA(162.1,"AF",B,A))
- WRITE !!,*7,"No payments rejected in this batch for that Invoice!"
- GOTO RDI
- +1 KILL QQ
- +2 SET QQ=0
- SET FBIN=A
- WRITE @IOF
- DO SETV^FBAACCB0
- DO HED^FBAACCB
- +3 FOR B2=0:0
- SET B2=$ORDER(^FBAA(162.1,"AF",B,A,B2))
- if B2'>0
- QUIT
- SET QQ=QQ+1
- SET QQ(QQ)=A_"^"_B2
- SET Z(0)=^FBAA(162.1,A,"RX",B2,0)
- DO MORE^FBAACCB1
- RLP SET DIR(0)="N^1:"_QQ
- SET DIR("A")="Re-initiate which line item"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO ENDP
- SET HX=X
- +1 IF '$DATA(QQ(HX))
- WRITE !!,*7,"You just did that one!!"
- GOTO RLP
- PRIN SET DIR(0)="Y"
- SET DIR("A")="Are you sure you want to re-initiate item number: "_HX
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!'Y
- GOTO RLP
- +1 SET J=$PIECE(QQ(HX),"^",1)
- SET K=$PIECE(QQ(HX),"^",2)
- +2 KILL FBERR
- +3 DO REJP^FBAARR1
- PASK SET DIR(0)="Y"
- SET DIR("A")=$SELECT($GET(FBERR):"",1:"Line Re-initiated. ")_"Want to re-initiate another"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO PASK
- if Y
- GOTO DELP
- GOTO ENDP
- ENDP ;
- +1 QUIT