- 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 Mar 13, 2025@21:01:08 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 ;
