Routine: FB35P50

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFB35P50   978     printed  Mar 13, 2025@20:59:31                                                                                                                                                                                                      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

FB35P50.m