FB35P50 ;ALBANY/JEH-POST INIT ROUTINE TO IDENTIFY CORRUPT VENDOR FILE ;11/16/02
;;3.5;FEE BASIS;**50**;JAN 30, 1995
; Loop through the Fee Basis Vender File looking for records with the
; "LOCAL VENDOR NAME" missing and if we have the "AUSTIN VENDOR NAME"
; write the "INTERNAL RECORD NUMBER","AUSTIN VENDOR NAME","ID NUMBER"
; and "CHAIN"(for pharmacy vendor only) into the INSTALL file.
N AMSNM,CHAIN,FBNMB,ID,TEMPOUT
S FBNMB=0
F S FBNMB=$O(^FBAAV(FBNMB)) Q:'FBNMB D ;
.I $P(^FBAAV(FBNMB,0),"^",1)="" D ;IF THE LOCAL VENDOR NAME MISSING
..S DIC=161.2,DR="30.01;1;8",DA=FBNMB,DIQ(0)="E",DIQ="TEMPOUT"
..D EN^DIQ1 K DIC,DR,DA,DIQ
..S AMSNM=$G(TEMPOUT(161.2,FBNMB,30.01,"E"))
..S ID=$G(TEMPOUT(161.2,FBNMB,1,"E"))
..S CHAIN=$G(TEMPOUT(161.2,FBNMB,8,"E"))
..I AMSNM'="" D ;
...D BMES^XPDUTL("INTERNAL ENTRY NUMBER: "_FBNMB)
...D MES^XPDUTL("AUSTIN NAME: "_AMSNM)
...D MES^XPDUTL("ID NUMBER: "_ID)
...D MES^XPDUTL("CHAIN: "_CHAIN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFB35P50 978 printed Nov 22, 2024@17:04:59 Page 2
FB35P50 ;ALBANY/JEH-POST INIT ROUTINE TO IDENTIFY CORRUPT VENDOR FILE ;11/16/02
+1 ;;3.5;FEE BASIS;**50**;JAN 30, 1995
+2 ; Loop through the Fee Basis Vender File looking for records with the
+3 ; "LOCAL VENDOR NAME" missing and if we have the "AUSTIN VENDOR NAME"
+4 ; write the "INTERNAL RECORD NUMBER","AUSTIN VENDOR NAME","ID NUMBER"
+5 ; and "CHAIN"(for pharmacy vendor only) into the INSTALL file.
+6 NEW AMSNM,CHAIN,FBNMB,ID,TEMPOUT
+7 SET FBNMB=0
+8 ;
FOR
SET FBNMB=$ORDER(^FBAAV(FBNMB))
if 'FBNMB
QUIT
Begin DoDot:1
+9 ;IF THE LOCAL VENDOR NAME MISSING
IF $PIECE(^FBAAV(FBNMB,0),"^",1)=""
Begin DoDot:2
+10 SET DIC=161.2
SET DR="30.01;1;8"
SET DA=FBNMB
SET DIQ(0)="E"
SET DIQ="TEMPOUT"
+11 DO EN^DIQ1
KILL DIC,DR,DA,DIQ
+12 SET AMSNM=$GET(TEMPOUT(161.2,FBNMB,30.01,"E"))
+13 SET ID=$GET(TEMPOUT(161.2,FBNMB,1,"E"))
+14 SET CHAIN=$GET(TEMPOUT(161.2,FBNMB,8,"E"))
+15 ;
IF AMSNM'=""
Begin DoDot:3
+16 DO BMES^XPDUTL("INTERNAL ENTRY NUMBER: "_FBNMB)
+17 DO MES^XPDUTL("AUSTIN NAME: "_AMSNM)
+18 DO MES^XPDUTL("ID NUMBER: "_ID)
+19 DO MES^XPDUTL("CHAIN: "_CHAIN)
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
