FBXIP127 ;ALB/DEP-Pre-Install Routine for FB*3.5*127 ; 5/3/13 11:31am
;;3.5;FEE BASIS;**127**;JAN 30, 1995;Build 9
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
POST ; Enrty point for routine
N DA,DFN,DIK,FB0,FBAUTH,FBFDC,FBMST,FBTYPE,FBJ,Y
S ^XTMP("FB127",0)=$$FMADD^XLFDT(DT,+90)_"^"_DT
S $P(^XTMP("FB127",0),"^",3)="MRA transactions pointing to deleted Authorizations."
GO ; Sort through "Pending" MRA entries.
S FBJ=0 F S FBJ=$O(^FBAA(161.26,"AC","P",FBJ)) Q:FBJ'>0 S FB0=$G(^FBAA(161.26,FBJ,0)) D
.D CHECK
Q
CHECK ;Checking Pt. info for valid authorizations.
; patient info;input:Y(0);output:FBDOB,FBFI,FBFLNAM,FBLNAM,FBMI,FBNAME,FBSEX,FBSSN
S DFN=$P(FB0,U)
S FBAUTH=$P(^FBAA(161.26,FBJ,0),"^",3) I FBAUTH']"" D DELMRA
I '$D(^FBAAA(DFN,1,FBAUTH,0)) D DELMRA
Q
DELMRA ; Deletes MRA entry that points to non-existent authorization.
S ^XTMP("FB127",FBJ)=^FBAA(161.26,FBJ,0)
S DIK="^FBAA(161.26,",DA=FBJ
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP127 982 printed Dec 13, 2024@02:01:13 Page 2
FBXIP127 ;ALB/DEP-Pre-Install Routine for FB*3.5*127 ; 5/3/13 11:31am
+1 ;;3.5;FEE BASIS;**127**;JAN 30, 1995;Build 9
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
POST ; Enrty point for routine
+1 NEW DA,DFN,DIK,FB0,FBAUTH,FBFDC,FBMST,FBTYPE,FBJ,Y
+2 SET ^XTMP("FB127",0)=$$FMADD^XLFDT(DT,+90)_"^"_DT
+3 SET $PIECE(^XTMP("FB127",0),"^",3)="MRA transactions pointing to deleted Authorizations."
GO ; Sort through "Pending" MRA entries.
+1 SET FBJ=0
FOR
SET FBJ=$ORDER(^FBAA(161.26,"AC","P",FBJ))
if FBJ'>0
QUIT
SET FB0=$GET(^FBAA(161.26,FBJ,0))
Begin DoDot:1
+2 DO CHECK
End DoDot:1
+3 QUIT
CHECK ;Checking Pt. info for valid authorizations.
+1 ; patient info;input:Y(0);output:FBDOB,FBFI,FBFLNAM,FBLNAM,FBMI,FBNAME,FBSEX,FBSSN
+2 SET DFN=$PIECE(FB0,U)
+3 SET FBAUTH=$PIECE(^FBAA(161.26,FBJ,0),"^",3)
IF FBAUTH']""
DO DELMRA
+4 IF '$DATA(^FBAAA(DFN,1,FBAUTH,0))
DO DELMRA
+5 QUIT
DELMRA ; Deletes MRA entry that points to non-existent authorization.
+1 SET ^XTMP("FB127",FBJ)=^FBAA(161.26,FBJ,0)
+2 SET DIK="^FBAA(161.26,"
SET DA=FBJ
+3 DO ^DIK
+4 QUIT
