FBXBIPS ;WIRMFO/SAB-POST INIT ;10/24/97
;;3.5;FEE BASIS;**10**;JAN 30, 1995
;
I $$PATCH^XPDUTL("FB*3.5*10") D BMES^XPDUTL(" Skipping Vendor check since patch was previously installed.") Q
;
N DA,FBC,FBDA,FBDA1,FBIEN1,FBT,FEEO,XPDIDTOT
D BMES^XPDUTL(" Marking Vendors with socio-economic data...")
K ^TMP($J)
S FBC("TOT")=+$P($G(^FBAAV(0)),U,4) ; total number of vendors
S FBC("VEN")=0 ; count of vendors examined
S FBC("MRA")=0 ; count of vendors added to 161.25
S XPDIDTOT=FBC("TOT") ; set total for status bar
S FBC("UPD")=5 ; initial % required to update status bar
S FBDA=0 F S FBDA=$O(^FBAAV(FBDA)) Q:'FBDA D
. ;
. S FBC("VEN")=FBC("VEN")+1 ; increment counter
. S FBC("%")=FBC("VEN")*100/FBC("TOT") ; calculate % complete
. ; check if status bar should be updated
. I FBC("%")>FBC("UPD") D
. . D UPDATE^XPDID(FBC("VEN")) ; update status bar
. . S FBC("UPD")=FBC("UPD")+5 ; increase update criteria by 5%
. ;
. Q:$P($G(^FBAAV(FBDA,1)),U,10)="" ; business type (fpds) null
. Q:$P($G(^FBAAV(FBDA,"ADEL")),U)="Y" ; austin deleted
. S FBDA1=$O(^FBAA(161.25,"AF",FBDA,0))
. I FBDA1]"",FBDA1'=FBDA Q ; linked to another vendor
. ;
. ; vendor should be reported to Central FEE
. I $D(^FBAA(161.25,FBDA)) D Q ; vendor already in 161.25
. . I $P($G(^FBAA(161.25,FBDA,0)),U,5)="" Q ; not sent - will incl fpds
. . S ^TMP($J,FBDA)="" ; can't update since awaiting austin action
. ; add to queue
. S (DA,FBIEN1)=FBDA,FBT="F",FEEO="" D SETGL^FBAAVD
. S FBC("MRA")=FBC("MRA")+1
D MES^XPDUTL(" "_FBC("MRA")_" Vendors were marked.")
;
I $D(^TMP($J)) D
. N FBDT,FBID,FBVEN,FBX,FBY
. D BMES^XPDUTL(" The following vendors could not be marked for transmission")
. D MES^XPDUTL(" because they are currently awaiting Austin action.")
. D BMES^XPDUTL(" Vendor Name ID Sent to Austin")
. D MES^XPDUTL(" ---------------------------------------- ----------- --------------")
. S FBDA=0 F S FBDA=$O(^TMP($J,FBDA)) Q:'FBDA D
. . S FBY(0)=$G(^FBAAV(FBDA,0))
. . S FBVEN=$E($P(FBY(0),U),1,40)
. . S FBID=$P(FBY(0),U,2)
. . S FBDT=$P($G(^FBAAV(FBDA,"ADEL")),U,2)
. . I FBDT]"" S FBDT=$$FMTE^XLFDT(FBDT)
. . S FBX=" "_$$LJ^XLFSTR(FBVEN,42)_$$LJ^XLFSTR(FBID,13)_FBDT
. . D MES^XPDUTL(FBX)
. D BMES^XPDUTL(" The Update FMS Vendor File in Austin [FBAA FMS UPDATE] option can be")
. D MES^XPDUTL(" used to send the socio-economic data for the listed vendors to")
. D MES^XPDUTL(" Austin after their current pending action has been resolved.")
;
K ^TMP($J)
Q
;FBXBIPS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXBIPS 2617 printed Sep 23, 2025@19:37 Page 2
FBXBIPS ;WIRMFO/SAB-POST INIT ;10/24/97
+1 ;;3.5;FEE BASIS;**10**;JAN 30, 1995
+2 ;
+3 IF $$PATCH^XPDUTL("FB*3.5*10")
DO BMES^XPDUTL(" Skipping Vendor check since patch was previously installed.")
QUIT
+4 ;
+5 NEW DA,FBC,FBDA,FBDA1,FBIEN1,FBT,FEEO,XPDIDTOT
+6 DO BMES^XPDUTL(" Marking Vendors with socio-economic data...")
+7 KILL ^TMP($JOB)
+8 ; total number of vendors
SET FBC("TOT")=+$PIECE($GET(^FBAAV(0)),U,4)
+9 ; count of vendors examined
SET FBC("VEN")=0
+10 ; count of vendors added to 161.25
SET FBC("MRA")=0
+11 ; set total for status bar
SET XPDIDTOT=FBC("TOT")
+12 ; initial % required to update status bar
SET FBC("UPD")=5
+13 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBAAV(FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+14 ;
+15 ; increment counter
SET FBC("VEN")=FBC("VEN")+1
+16 ; calculate % complete
SET FBC("%")=FBC("VEN")*100/FBC("TOT")
+17 ; check if status bar should be updated
+18 IF FBC("%")>FBC("UPD")
Begin DoDot:2
+19 ; update status bar
DO UPDATE^XPDID(FBC("VEN"))
+20 ; increase update criteria by 5%
SET FBC("UPD")=FBC("UPD")+5
End DoDot:2
+21 ;
+22 ; business type (fpds) null
if $PIECE($GET(^FBAAV(FBDA,1)),U,10)=""
QUIT
+23 ; austin deleted
if $PIECE($GET(^FBAAV(FBDA,"ADEL")),U)="Y"
QUIT
+24 SET FBDA1=$ORDER(^FBAA(161.25,"AF",FBDA,0))
+25 ; linked to another vendor
IF FBDA1]""
IF FBDA1'=FBDA
QUIT
+26 ;
+27 ; vendor should be reported to Central FEE
+28 ; vendor already in 161.25
IF $DATA(^FBAA(161.25,FBDA))
Begin DoDot:2
+29 ; not sent - will incl fpds
IF $PIECE($GET(^FBAA(161.25,FBDA,0)),U,5)=""
QUIT
+30 ; can't update since awaiting austin action
SET ^TMP($JOB,FBDA)=""
End DoDot:2
QUIT
+31 ; add to queue
+32 SET (DA,FBIEN1)=FBDA
SET FBT="F"
SET FEEO=""
DO SETGL^FBAAVD
+33 SET FBC("MRA")=FBC("MRA")+1
End DoDot:1
+34 DO MES^XPDUTL(" "_FBC("MRA")_" Vendors were marked.")
+35 ;
+36 IF $DATA(^TMP($JOB))
Begin DoDot:1
+37 NEW FBDT,FBID,FBVEN,FBX,FBY
+38 DO BMES^XPDUTL(" The following vendors could not be marked for transmission")
+39 DO MES^XPDUTL(" because they are currently awaiting Austin action.")
+40 DO BMES^XPDUTL(" Vendor Name ID Sent to Austin")
+41 DO MES^XPDUTL(" ---------------------------------------- ----------- --------------")
+42 SET FBDA=0
FOR
SET FBDA=$ORDER(^TMP($JOB,FBDA))
if 'FBDA
QUIT
Begin DoDot:2
+43 SET FBY(0)=$GET(^FBAAV(FBDA,0))
+44 SET FBVEN=$EXTRACT($PIECE(FBY(0),U),1,40)
+45 SET FBID=$PIECE(FBY(0),U,2)
+46 SET FBDT=$PIECE($GET(^FBAAV(FBDA,"ADEL")),U,2)
+47 IF FBDT]""
SET FBDT=$$FMTE^XLFDT(FBDT)
+48 SET FBX=" "_$$LJ^XLFSTR(FBVEN,42)_$$LJ^XLFSTR(FBID,13)_FBDT
+49 DO MES^XPDUTL(FBX)
End DoDot:2
+50 DO BMES^XPDUTL(" The Update FMS Vendor File in Austin [FBAA FMS UPDATE] option can be")
+51 DO MES^XPDUTL(" used to send the socio-economic data for the listed vendors to")
+52 DO MES^XPDUTL(" Austin after their current pending action has been resolved.")
End DoDot:1
+53 ;
+54 KILL ^TMP($JOB)
+55 QUIT
+56 ;FBXBIPS
