Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBXIP39

FBXIP39.m

Go to the documentation of this file. 
  1. FBXIP39 ;WOIFO/SS-PATCH INSTALL ROUTINE ;7/13/01
  1.  ;;3.5;FEE BASIS;**39**;JAN 30, 1995
  1.  ;File #161.2 conversion routine
  1.  Q  ;stub
  1.  ;/**
  1.  ;post-install entry point
  1. EN39 ;*/
  1.  D KILTMP
  1.  I $$PATCH^XPDUTL("FB*3.5*39") D BMES^XPDUTL("  Skipping Vendor file conversion since patch was previously installed.") Q
  1.  N FBQCNT,FBRVCNT,FBCNT S (FBQCNT,FBRVCNT,FBCNT)=0 ;counters
  1.  D TMPGL
  1.  D BMES^XPDUTL("  Processing Q-code: "_FBQCNT_" entries.")
  1.  D QCODE
  1.  D BMES^XPDUTL("  Processing RV-code: "_FBRVCNT_" entries.")
  1.  D RVCODE
  1.  D BMES^XPDUTL("  Marked to be sent to Austin for update: "_FBCNT_" entries.")
  1.  D NMARKED
  1.  D KILTMP
  1.  Q
  1.  ;/**
  1.  ;kills ^TMP
  1. KILTMP ;*/
  1.  K ^TMP($J,"FBXIPQR")
  1.  K ^TMP($J,"FBXIP39")
  1.  Q
  1.  ;/**
  1.  ;TMPGL
  1.  ;Create ^TMP with all essential codes
  1. TMPGL ;*/
  1.  N FBIEN,FBN,FBQ,FBRV,FBFPDS
  1.  S FBQ=158 ;Q-code
  1.  S FBRV=167 ;RV-code
  1.  S FBIEN=0
  1.  F  S FBIEN=$O(^FBAAV(FBIEN)) Q:'FBIEN  D
  1.  . Q:$P($G(^FBAAV(FBIEN,2,0)),"^",4)<1
  1.  . S FBN=0
  1.  . F  S FBN=$O(^FBAAV(FBIEN,2,FBN)) Q:'FBN  D
  1.  . . S FBFPDS=$G(^FBAAV(FBIEN,2,FBN,0))
  1.  . . I FBFPDS=FBRV S ^TMP($J,"FBXIPQR",FBFPDS,FBIEN)=FBN,FBRVCNT=FBRVCNT+1 Q
  1.  . . I FBFPDS=FBQ S ^TMP($J,"FBXIPQR",FBFPDS,FBIEN)=FBN,FBQCNT=FBQCNT+1 Q
  1.  Q
  1.  ;
  1.  ;
  1.  ;/**
  1.  ;QCODE
  1.  ;For all vendors with Q-code do the following:
  1.  ;1) add to correction file to inform Austin about changes
  1.  ;2) delete "Q"- code
  1.  ;3) if there is no "S" code for the vendor - add "S" code
  1.  ;   but only if it is SMALL BUSINESS type
  1. QCODE ;*/
  1.  N FBIEN,FBQ,FBS
  1.  S FBQ=158 ;Q-code
  1.  S FBS=162 ;S-code
  1.  S FBIEN=0
  1.  F  S FBIEN=$O(^TMP($J,"FBXIPQR",FBQ,FBIEN)) Q:'FBIEN  D
  1.  . D ADDCORR(FBIEN) ;add to correction file
  1.  . D CHNGITEM(FBIEN,$G(^TMP($J,"FBXIPQR",FBQ,FBIEN)),"@")
  1.  . ;if business type (fpds) null or not Small Business
  1.  . I $P($G(^FBAAV(FBIEN,1)),"^",10)'=1 Q
  1.  . I $O(^FBAAV(FBIEN,2,"B",FBS,0))'="" Q
  1.  . D INSITEM(FBIEN,FBS)
  1.  Q
  1.  ;
  1.  ;/**
  1.  ;RVCODE
  1.  ;For all vendors with RV-code do the following:
  1.  ;1) add to correction file to inform Austin
  1. RVCODE ;*/
  1.  N FBIEN,FBRV
  1.  S FBRV=167 ;RV-code
  1.  S FBIEN=0
  1.  F  S FBIEN=$O(^TMP($J,"FBXIPQR",FBRV,FBIEN)) Q:'FBIEN  D
  1.  . D ADDCORR(FBIEN) ;add to correction file
  1.  Q
  1.  ;
  1.  ;/**
  1.  ;ADDCORR
  1.  ;Add vendors with changes to correction file (#161.25)
  1.  ;
  1. ADDCORR(FBIEN) ;*/
  1.  ;if business type (fpds) null
  1.  I $P($G(^FBAAV(FBIEN,1)),"^",10)="" Q
  1.  ;
  1.  ;if Austin deleted
  1.  I $P($G(^FBAAV(FBIEN,"ADEL")),"^")="Y" Q
  1.  ;
  1.  ;if linked to another vendor
  1.  N FBDA1 S FBDA1=$O(^FBAA(161.25,"AF",FBIEN,0))
  1.  I FBDA1]"",FBDA1'=FBIEN Q  ;linked to another vendor
  1.  ;
  1.  ;if vendor already in 161.25
  1.  I $D(^FBAA(161.25,FBIEN)) D  Q
  1.  . ;
  1.  . ;not place the  entry - previous change was not transmitted yet, 
  1.  . ;will be transmitted with new fpds
  1.  . I $P($G(^FBAA(161.25,FBIEN,0)),"^",5)="" S FBCNT=$$FBCNTINC() Q
  1.  . ;
  1.  . ;save it for a list of non-processed
  1.  . ;vendors. Previous change was transmitted to 
  1.  . ;Austin but there is no reply for the change from Austin yet, 
  1.  . ;so at the moment we cannot perform new transmission to Austin
  1.  . S ^TMP($J,"FBXIP39",FBIEN)=""
  1.  . Q
  1.  ;if it is already marked
  1.  Q:$D(FBCNT(FBIEN))
  1.  ;otherwise file it
  1.  N FEEO,FBT,FBIEN1,DA S (DA,FBIEN1)=FBIEN,FBT="F",FEEO="" D SETGL^FBAAVD
  1.  S FBCNT=$$FBCNTINC()
  1.  Q
  1.  ;
  1.  ;/**
  1.  ;Counter for marked vendors
  1.  ;
  1. FBCNTINC() ;*/
  1.  Q:$D(FBCNT(FBIEN)) FBCNT
  1.  S FBCNT(FBIEN)=""
  1.  Q FBCNT+1
  1.  ;
  1.  ;/**
  1.  ;CHNGITEM
  1.  ;change or delete FPDS code
  1. CHNGITEM(FBIEN,FBN,FBCOD) ;*/
  1.  N FBIENS,FBFDA
  1.  S FBIENS=FBN_","_FBIEN_","
  1.  S FBFDA(161.225,FBIENS,.01)=FBCOD
  1.  D FILE^DIE("","FBFDA")
  1.  Q
  1.  ;
  1.  ;/**
  1.  ;INSITEM
  1.  ;insert FPDS code
  1. INSITEM(FBIEN,FBCOD) ;*/
  1.  N FBSSI,FBIENS,FBFDA,FBER
  1.  S FBIENS="+1,"_FBIEN_","
  1.  S FBFDA(161.225,FBIENS,.01)=FBCOD
  1.  D UPDATE^DIE("","FBFDA","FBSSI","FBER")
  1.  I $D(FBER) D BMES^XPDUTL(FBER("DIERR",1,"TEXT",1))
  1.  Q
  1.  ;
  1.  ;/**
  1.  ;print all vendors that were not marked to sent to Austin
  1.  ;
  1. NMARKED ;*/
  1.  Q:'$D(^TMP($J,"FBXIP39"))
  1.  N FBDT,FBID,FBVEN,FBX,FB,FBY,FBDA
  1.  D BMES^XPDUTL("  The following vendors could not be marked for transmission")
  1.  D MES^XPDUTL("  because they are currently awaiting Austin action.")
  1.  D BMES^XPDUTL("   Vendor Name                               ID           Sent to Austin")
  1.  D MES^XPDUTL("   ----------------------------------------  -----------  --------------")
  1.  S FBDA=0 F  S FBDA=$O(^TMP($J,"FBXIP39",FBDA)) Q:'FBDA  D
  1.  . S FBY(0)=$G(^FBAAV(FBDA,0))
  1.  . S FBVEN=$E($P(FBY(0),"^"),1,40)
  1.  . S FBID=$P(FBY(0),"^",2)
  1.  . S FBDT=$P($G(^FBAAV(FBDA,"ADEL")),"^",2)
  1.  . I FBDT]"" S FBDT=$$FMTE^XLFDT(FBDT)
  1.  . S FBX="   "_$$LJ^XLFSTR(FBVEN,42)_$$LJ^XLFSTR(FBID,13)_FBDT
  1.  . D MES^XPDUTL(FBX)
  1.  D BMES^XPDUTL("  The Update FMS Vendor File in Austin [FBAA FMS UPDATE] option can be")
  1.  D MES^XPDUTL("  used to send the socio-economic data for the listed vendors to")
  1.  D MES^XPDUTL("  Austin after their current pending action has been resolved.")
  1.  Q
  1.  ;