FBXIP127.m

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 ---FBXIP127   982     printed  Feb 18, 2025@23:27:39                                                                                                                                                                                                     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