FBUCDD2 ;MNTFW/RGB - DD UTILITY ;4/25/15
;;3.5;FEE BASIS;**161**;JAN 30, 1995;Build 10
;;Per VA Directive 6402, this routine should not be modified.
;
;FB*3.5*161 Patient MRA delete from MRA Transmission file
; 161.26 when linked patient authorization is
; deleted. Had to move DELB as separate call from
; DELA tag (checks for allowing delete) so the
; patient MRAs are only deleted when the user
; actually can respond 'YES' to delete query.
; Linked to FROM DATE x-ref xxxx which calls this
; delete process when authorization is fully deleted.
;
DELB(DA) ; FB*3.5*161 Patient MRA delete (161.26) for deleted linked authorization
I $P(^FBAAA(DA(1),1,DA,0),U,13)=1,$D(^FBAA(161.26,"B",DA(1))) D
. N FBDA,DIK,FBHDA,FBHDA1
. S FBDA=0 F S FBDA=$O(^FBAA(161.26,"B",DA(1),FBDA)) Q:'FBDA D
. . I $P(^FBAA(161.26,FBDA,0),U,3)'=DA Q
. . S FBHDA=DA,FBHDA1=DA(1) K DA(1)
. . S DIK="^FBAA(161.26,",DA=FBDA D ^DIK
. . S DA=FBHDA,DA(1)=FBHDA1
DELBQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCDD2 1057 printed Nov 22, 2024@17:10:15 Page 2
FBUCDD2 ;MNTFW/RGB - DD UTILITY ;4/25/15
+1 ;;3.5;FEE BASIS;**161**;JAN 30, 1995;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;FB*3.5*161 Patient MRA delete from MRA Transmission file
+5 ; 161.26 when linked patient authorization is
+6 ; deleted. Had to move DELB as separate call from
+7 ; DELA tag (checks for allowing delete) so the
+8 ; patient MRAs are only deleted when the user
+9 ; actually can respond 'YES' to delete query.
+10 ; Linked to FROM DATE x-ref xxxx which calls this
+11 ; delete process when authorization is fully deleted.
+12 ;
DELB(DA) ; FB*3.5*161 Patient MRA delete (161.26) for deleted linked authorization
+1 IF $PIECE(^FBAAA(DA(1),1,DA,0),U,13)=1
IF $DATA(^FBAA(161.26,"B",DA(1)))
Begin DoDot:1
+2 NEW FBDA,DIK,FBHDA,FBHDA1
+3 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBAA(161.26,"B",DA(1),FBDA))
if 'FBDA
QUIT
Begin DoDot:2
+4 IF $PIECE(^FBAA(161.26,FBDA,0),U,3)'=DA
QUIT
+5 SET FBHDA=DA
SET FBHDA1=DA(1)
KILL DA(1)
+6 SET DIK="^FBAA(161.26,"
SET DA=FBDA
DO ^DIK
+7 SET DA=FBHDA
SET DA(1)=FBHDA1
End DoDot:2
End DoDot:1
DELBQ QUIT
