- 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 Mar 13, 2025@21:04:59 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
