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

FBAAUTL6.m

Go to the documentation of this file.
  1. FBAAUTL6 ;WCIOFO/SAB-UTILITY ROUTINE ;9/11/97
  1. ;;3.5;FEE BASIS;**9,36**;JAN 30, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. VGRP(FBDA) ; Validate/Correct Socioeconomic Groups Extrinsic Function
  1. ; called by input templates FBAA NEW VENDOR, FBAA EDIT VENDOR
  1. ; input FBDA - ien of vendor in 161.2
  1. ; returns - True when groups were changed or False when groups were OK
  1. N FB,FBBT,FBCHG,FBFDA,FBG,FBIENS
  1. S FBCHG=0
  1. ; get current business type and groups
  1. S FBBT=$$GET1^DIQ(161.2,FBDA,24,"I")
  1. D GETS^DIQ(161.2,FBDA_",","25*","IE","FB")
  1. ; check groups against type
  1. S FBIENS="" F S FBIENS=$O(FB(161.225,FBIENS)) Q:FBIENS="" D
  1. . I FBBT]"",$$GET1^DIQ(420.6,FB(161.225,FBIENS,.01,"I"),5)[FBBT Q ; OK
  1. . W !," Group ",FB(161.225,FBIENS,.01,"E")," inappropriate for Business Type. Deleting..."
  1. . S FBFDA(161.225,FBIENS,.01)="@"
  1. . K FB(161.225,FBIENS)
  1. I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG() S FBCHG=1
  1. ; check group combinations
  1. ; first build list by group codes
  1. S FBIENS="" F S FBIENS=$O(FB(161.225,FBIENS)) Q:FBIENS="" D
  1. . S FBG(FB(161.225,FBIENS,.01,"E"))=FBIENS
  1. . S FBG=$G(FBG)+1
  1. ; check use of OO with others
  1. I $D(FBG("OO")),$G(FBG)>1 D
  1. . W !," Group OO can't be used with other groups. Deleting OO..."
  1. . S FBFDA(161.225,FBG("OO"),.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG() S FBCHG=1
  1. ; check S
  1. I $D(FBG("RV")),'$D(FBG("S")) D
  1. . W !," Group S must be specified with group RV. Adding S..."
  1. . S FBFDA(161.225,"+1,"_FBDA_",",.01)="S"
  1. . D UPDATE^DIE("E","FBFDA") D MSG^DIALOG() S FBCHG=1
  1. Q FBCHG
  1. ;
  1. GETGRP(FBDA,FBMAX) ; Get Socioeconomic Groups for a Vendor
  1. ; in FBDA - vendor ien
  1. ; FBMAX - (optional) maximum number of groups to retrieve
  1. ; out FBSG( array - i.e. FBSG(1)=code, FBSG(2)=code, etc.
  1. N FB,FBC,FBIENS
  1. K FBSG
  1. I '$G(FBMAX) S FBMAX=999
  1. D GETS^DIQ(161.2,FBDA_",","25*","","FB")
  1. S FBC=0,FBIENS=""
  1. F S FBIENS=$O(FB(161.225,FBIENS)) Q:FBIENS="" D Q:(FBC=FBMAX)
  1. . S FBC=FBC+1,FBSG(FBC)=FB(161.225,FBIENS,.01)
  1. Q
  1. ;
  1. GRPDIF(FBDA) ; Socioeconomic Groups Different Extrinsic Function?
  1. ; in FBDA - vendor ien
  1. ; FBSG( array of groups
  1. ; returns True (when different) or False (when equivalent)
  1. N FB,FBARRAY,FBFILE,FBG,FBX,FBY
  1. ; create sorted list of groups from array
  1. S FBX="" F S FBX=$O(FBSG(FBX)) Q:FBX="" D
  1. . S FBY=FBSG(FBX) Q:FBY=""
  1. . S FBG(FBY)=""
  1. S (FBARRAY,FBY)="" F S FBY=$O(FBG(FBY)) Q:FBY="" S FBARRAY=FBARRAY_FBY
  1. ; create sorted list of groups from file
  1. D GETS^DIQ(161.2,FBDA_",","25*","","FB")
  1. K FBG
  1. S FBX="" F S FBX=$O(FB(161.225,FBX)) Q:FBX="" D
  1. . S FBY=FB(161.225,FBX,.01) Q:FBY=""
  1. . S FBG(FBY)=""
  1. S (FBFILE,FBY)="" F S FBY=$O(FBG(FBY)) Q:FBY="" S FBFILE=FBFILE_FBY
  1. ; compare
  1. Q FBFILE'=FBARRAY
  1. ;
  1. UPDGRP(FBDA) ; Update Socioeconomic Groups of Vendor
  1. ; in FBDA - vendor ien
  1. ; FBSG( array
  1. N FB,FBBT,FBFDA,FBI,FBIENS
  1. ; delete current vendor groups
  1. D GETS^DIQ(161.2,FBDA_",","25*","","FB")
  1. S FBIENS="" F S FBIENS=$O(FB(161.225,FBIENS)) Q:FBIENS="" D
  1. . S FBFDA(161.225,FBIENS,.01)="@"
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ; store groups from array in vendor
  1. N FBVNCOD,FBVNDAT,FBVNDBL
  1. S FBBT=$$GET1^DIQ(161.2,FBDA,24,"I") ;get business type
  1. S FBI=0 F S FBI=$O(FBSG(FBI)) Q:'FBI D
  1. . Q:FBSG(FBI)=""
  1. . ; find internal values with correct business type and effective date
  1. . S FBVNCOD=0
  1. . F S FBVNCOD=$O(^PRCD(420.6,"B",FBSG(FBI),FBVNCOD)) Q:+FBVNCOD=0 S FBVNDAT=$G(^PRCD(420.6,FBVNCOD,0)) Q:$P(FBVNDAT,"^",6)[$G(FBBT)&($P(FBVNDAT,"^",3)=1)
  1. . Q:+FBVNCOD=0
  1. . ;do not file "Q" for SMALL BUSINESS - file "S" instead
  1. . S:FBVNCOD=158 FBVNCOD=162
  1. . ;R->RV for SMALL BUSINESS
  1. . S:FBVNCOD=159 FBVNCOD=167
  1. . ; place internal value in FBFDA if it is not already in there
  1. . D Q:FBVNDBL'="" S FBFDA(161.225,"+"_FBI_","_FBDA_",",.01)=FBVNCOD
  1. . . S FBVNDBL=0 F S FBVNDBL=$O(FBFDA(161.225,FBVNDBL)) Q:'FBVNDBL Q:FBFDA(161.225,FBVNDBL,".01")=FBVNCOD
  1. ; file internal values in file
  1. I $D(FBFDA) D UPDATE^DIE("","FBFDA")
  1. Q