FBAARMRA ;AISC/DMK-RETRANSMIT MRA's FOR A DATE ;25OCT89
;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
;;Per VA Directive 6402, this routine should not be modified.
;
ASK W !! S %DT("A")="Re-transmit MRA's for which date: ",%DT="AEXP",%DT(0)=-DT D ^%DT K %DT(0),%DT("A") G END:X="^"!(X=""),ASK:Y<0 S FBAATD=Y
I '$D(^FBAA(161.25,"AD",FBAATD)),'$D(^FBAA(161.26,"AD",FBAATD)),'$D(^FBAA(161.96,"AD",FBAATD)) W !!,*7,"No MRA's were transmitted on that date!" G ASK
;
D VEND:$D(^FBAA(161.25,"AD",FBAATD)),VET:$D(^FBAA(161.26,"AD",FBAATD))
;
D:$D(^FBAA(161.96,"AD",FBAATD)) IA(FBAATD) ; prepare IPAC MRAs for retransmission (FB*3.5*123)
;
D RTRAN^FBAAV0
END K D0,FBAATD,OCTD,J,K,XCNP,VAT Q
;
VEND F J="O","P" F K=0:0 S K=$O(^FBAA(161.25,"AD",FBAATD,J,K)) Q:K'>0 I $D(^FBAA(161.25,K)) S $P(^(K,0),"^",5)="",^FBAA(161.25,"AE",J,K)="" K ^FBAA(161.25,"AD",FBAATD,J,K)
Q
VET W !!,?20,"Re-Transmitting",! F K=0:0 S K=$O(^FBAA(161.26,"AD",FBAATD,K)) Q:K'>0 I $D(^FBAA(161.26,K)) S $P(^(K,0),"^",5)="",$P(^(0),"^",2)="P",^FBAA(161.26,"AC","P",K)="" K ^FBAA(161.26,"AD",FBAATD,K),^FBAA(161.26,"AC","T",K)
Q
;
IA(XMITDT) ; Prepare IPAC Agreement MRAs for re-transmission
; Input: XMITDT - Internal date to re-transmit IPAC Agreement MRAs for
; Output: IPAC Agreement MRAs for the selected date are prepared for re-transmission
; Called From: ASK
N DIE,DA,DR,DTOUT,MRAACT,MRAIEN,K,TACT,VAID,VAIEN
;
; Loop through every transmitted Patient MRA record for the specified date and
; remove the transmitted date
S K=0
F D Q:K'>0
. S K=$O(^FBAA(161.96,"AD",XMITDT,K))
. Q:'K
. ;
. ; IPAC vendor agreement IEN in file 161.95 for this transmitted MRA
. S VAIEN=$P($G(^FBAA(161.96,K,0)),U,2),MRAIEN=""
. S VAID=$P($G(^FBAA(161.96,K,0)),U,3)
. ;
. ; This must be an Add or a change MRA record for an Agreement that was
. ; later deleted - Skip it
. I VAIEN'="",'$D(^FBAA(161.95,VAIEN)) Q
. I VAIEN S MRAIEN=$$PENDMRA^FBAAIAQ(VAID,.MRAACT)
. ;
. ; if there is an existing Pending MRA, then we'll use it and get out
. I MRAIEN>0 D Q
. . S TACT=$P($G(^FBAA(161.96,K,0)),U,4) ; Action value of transmitted MRA
. . I TACT="A",MRAACT="C" D ; Change pending action to add action
. . . S DIE=161.96,DA=MRAIEN,DR="3////A"
. . . D ^DIE
. ;
. ; Otherwise, change the status of this MRA back to Pending and remove the Date Transmitted field
. I $D(^FBAA(161.96,K)) D
. . S DIE=161.96,DA=K
. . S DR="4////P" ; Set the status back to Pending
. . S DR=DR_";5////@" ; Remove the transmitted date from the record
. . D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAARMRA 2688 printed Dec 13, 2024@01:56:26 Page 2
FBAARMRA ;AISC/DMK-RETRANSMIT MRA's FOR A DATE ;25OCT89
+1 ;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
ASK WRITE !!
SET %DT("A")="Re-transmit MRA's for which date: "
SET %DT="AEXP"
SET %DT(0)=-DT
DO ^%DT
KILL %DT(0),%DT("A")
if X="^"!(X="")
GOTO END
if Y<0
GOTO ASK
SET FBAATD=Y
+1 IF '$DATA(^FBAA(161.25,"AD",FBAATD))
IF '$DATA(^FBAA(161.26,"AD",FBAATD))
IF '$DATA(^FBAA(161.96,"AD",FBAATD))
WRITE !!,*7,"No MRA's were transmitted on that date!"
GOTO ASK
+2 ;
+3 if $DATA(^FBAA(161.25,"AD",FBAATD))
DO VEND
if $DATA(^FBAA(161.26,"AD",FBAATD))
DO VET
+4 ;
+5 ; prepare IPAC MRAs for retransmission (FB*3.5*123)
if $DATA(^FBAA(161.96,"AD",FBAATD))
DO IA(FBAATD)
+6 ;
+7 DO RTRAN^FBAAV0
END KILL D0,FBAATD,OCTD,J,K,XCNP,VAT
QUIT
+1 ;
VEND FOR J="O","P"
FOR K=0:0
SET K=$ORDER(^FBAA(161.25,"AD",FBAATD,J,K))
if K'>0
QUIT
IF $DATA(^FBAA(161.25,K))
SET $PIECE(^(K,0),"^",5)=""
SET ^FBAA(161.25,"AE",J,K)=""
KILL ^FBAA(161.25,"AD",FBAATD,J,K)
+1 QUIT
VET WRITE !!,?20,"Re-Transmitting",!
FOR K=0:0
SET K=$ORDER(^FBAA(161.26,"AD",FBAATD,K))
if K'>0
QUIT
IF $DATA(^FBAA(161.26,K))
SET $PIECE(^(K,0),"^",5)=""
SET $PIECE(^(0),"^",2)="P"
SET ^FBAA(161.26,"AC","P",K)=""
KILL ^FBAA(161.26,"AD",FBAATD,K),^FBAA(161.26,"AC","T",K)
+1 QUIT
+2 ;
IA(XMITDT) ; Prepare IPAC Agreement MRAs for re-transmission
+1 ; Input: XMITDT - Internal date to re-transmit IPAC Agreement MRAs for
+2 ; Output: IPAC Agreement MRAs for the selected date are prepared for re-transmission
+3 ; Called From: ASK
+4 NEW DIE,DA,DR,DTOUT,MRAACT,MRAIEN,K,TACT,VAID,VAIEN
+5 ;
+6 ; Loop through every transmitted Patient MRA record for the specified date and
+7 ; remove the transmitted date
+8 SET K=0
+9 FOR
Begin DoDot:1
+10 SET K=$ORDER(^FBAA(161.96,"AD",XMITDT,K))
+11 if 'K
QUIT
+12 ;
+13 ; IPAC vendor agreement IEN in file 161.95 for this transmitted MRA
+14 SET VAIEN=$PIECE($GET(^FBAA(161.96,K,0)),U,2)
SET MRAIEN=""
+15 SET VAID=$PIECE($GET(^FBAA(161.96,K,0)),U,3)
+16 ;
+17 ; This must be an Add or a change MRA record for an Agreement that was
+18 ; later deleted - Skip it
+19 IF VAIEN'=""
IF '$DATA(^FBAA(161.95,VAIEN))
QUIT
+20 IF VAIEN
SET MRAIEN=$$PENDMRA^FBAAIAQ(VAID,.MRAACT)
+21 ;
+22 ; if there is an existing Pending MRA, then we'll use it and get out
+23 IF MRAIEN>0
Begin DoDot:2
+24 ; Action value of transmitted MRA
SET TACT=$PIECE($GET(^FBAA(161.96,K,0)),U,4)
+25 ; Change pending action to add action
IF TACT="A"
IF MRAACT="C"
Begin DoDot:3
+26 SET DIE=161.96
SET DA=MRAIEN
SET DR="3////A"
+27 DO ^DIE
End DoDot:3
End DoDot:2
QUIT
+28 ;
+29 ; Otherwise, change the status of this MRA back to Pending and remove the Date Transmitted field
+30 IF $DATA(^FBAA(161.96,K))
Begin DoDot:2
+31 SET DIE=161.96
SET DA=K
+32 ; Set the status back to Pending
SET DR="4////P"
+33 ; Remove the transmitted date from the record
SET DR=DR_";5////@"
+34 DO ^DIE
End DoDot:2
End DoDot:1
if K'>0
QUIT
+35 QUIT
+36 ;
