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

ACRFVLK.m

Go to the documentation of this file. 
  1. ACRFVLK ;IHS/OIRM/DSD/AEF - VENDOR FILE LOOKUP ; [ 03/28/2007  10:56 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**21,22**;NOV 5, 2001
  1.  ;
  1.  ;    New routine ACR*2.1*20.14
  1.  ;    Copied from AUTTVLK.  Vendor Add/Edit with additional mods
  1.  ;                          mods to accomidate vendor screen changes
  1.  ; Routine heavily modified for UFMS requirements ACR*2.1*22 UFMS
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. ADD ; EP - Add or Edit Vendor data.
  1.  D ^XBKVAR
  1.  N ACRVND,ACRVAUTH,ACRDIC
  1.  S ACRQUIT=0                                 ; Initialize quit flags
  1.  S ACRVAUTH=$$EDITAUTH(DUZ)                  ; Get ARMS User Vendor Edit Authority
  1.  F  D  Q:+ACRQUIT
  1.  . D ASKVND                                  ; Add/Lookup Vendor
  1.  . Q:+ACRQUIT                                ; Add/Lookup failed or user opted out
  1.  . I +$P(ACRVND,U,3) D                       ; New vendor, edit all data
  1.  . . S DR="[ACR VENDOR EDIT]"
  1.  . . D SCREEN(ACRVND,DR)
  1.  . I '+$P(ACRVND,U,3) D  Q:+ACRQUIT          ; Existing vendor, checks then edit
  1.  . . D DISP                                  ; display current vendor data
  1.  . . D CHKACTV                               ; Check if vendor active
  1.  . . D DUNSCHK
  1.  . . Q:+ACRQUIT
  1.  . . I ",A,C,F,"'[(","_ACRVAUTH_",") D MSG   ; Check Vendor authority
  1.  . . Q:+ACRQUIT
  1.  . F  D EDIT Q:+ACRQUIT                      ; Edit Vendor Data
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. EDITAUTH(X) ; EP; Check user's Vendor Edit Authority in ARMS USER File
  1.  I '+X Q ""
  1.  S Y=$$GET1^DIQ(9002185.3,X,17,"I")
  1.  Q Y
  1.  ; ********************************************************************
  1.  ;
  1. ASKVND ; Ask / Lookup Vendor
  1.  ; Only allow Vendor addition if Vendor Edit Authority is F, C, or A.
  1.  W:$D(IOF) @IOF
  1.  K DD,DO,X,Y,DIC,DA,DR,DINUM,D,DLAYGO
  1.  S DIC="^AUTTVNDR("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Edit which Vendor? "
  1.  I ",A,C,F,"[(","_ACRVAUTH_",") D
  1.  . S DIC(0)=DIC(0)_"L"
  1.  . S DIC("A")="Add/Edit which Vendor? "
  1.  . S DLAYGO=9999999.11
  1.  D ^DIC
  1.  I +Y<1 S ACRQUIT=1 Q
  1.  S ACRVND=Y
  1.  S ACRVND(0)=Y(0)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DISP ;EP - If not new entry, display Current Vendor data.
  1.  S DR="[ACR VENDOR DISPLAY]"
  1.  D SCREEN(ACRVND,DR)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. CHKACTV ; Check to see if Vendor has been inactivated
  1.  S ACRQUIT=0
  1.  S ACRACTV=$$GET1^DIQ(9999999.11,+ACRVND,.05,"E")
  1.  I ACRACTV'="" D               ; Inactive Vendor
  1.  . S ACRQUIT=1
  1.  . S DR="[ACR VENDOR DISPLAY-INACTIVE]"
  1.  . D SCREEN(ACRVND,DR)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. MSG ;EP - Message edit authority denied
  1.  S ACRQUIT=1
  1.  S DR="[ACR VENDOR DISPLAY-AUTHORITY]"
  1.  D SCREEN(ACRVND,DR)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. EDIT ; Edit which vendor data
  1.  K DA,X,Y,DR,DIR
  1.  D ^XBFMK
  1.  S DIR(0)="SO^1:ALL Vendor Data;"
  1.  S DIR(0)=DIR(0)_"2:Mailing Address;"
  1.  S DIR(0)=DIR(0)_"3:Billing Address;"
  1.  S DIR(0)=DIR(0)_"4:Remit To Address;"
  1.  S DIR(0)=DIR(0)_"5:1099 Payment Data;"
  1.  S DIR(0)=DIR(0)_"6:ARMS/CIS;"
  1.  S DIR(0)=DIR(0)_"7:SMALL PURCHASE INFORMATION Data"
  1.  S DIR("A")="Edit which data"
  1.  S DIR("?")="Enter the code from the list to indicate the type of data you want to edit."
  1.  W !
  1.  D ^DIR
  1.  I (Y<1!(Y>7)) S ACRQUIT=1 Q
  1.  I ",F,A,"'[(","_ACRVAUTH_",")&(Y=5) D  Q    ; A or F auth req for Pay data
  1.  . S DR="[ACR VENDOR DISPLAY-AUTHORITY]"
  1.  . D SCREEN(ACRVND,DR)
  1.  I ",C,A,"'[(","_ACRVAUTH_",")&((Y=6)!(Y=7)) D  Q    ; A or C auth req for CIS/SP data
  1.  . S DR="[ACR VENDOR DISPLAY-AUTHORITY]"
  1.  . D SCREEN(ACRVND,DR)
  1.  S:Y DR="]"
  1.  S:Y=2 DR="-MAIL]"
  1.  S:Y=3 DR="-BILL]"
  1.  S:Y=4 DR="-REMIT]"
  1.  S:Y=5 DR="-PAY]"
  1.  S:Y=6 DR="-CIS]"
  1.  S:Y=7 DR="-SPIS]"
  1.  S DR="[ACR VENDOR EDIT"_DR
  1.  D SCREEN(ACRVND,DR)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. SCREEN(ACRVND,DR) ; EP; call screen man
  1.  ; pass in DR
  1.  ; pass in ACRVND
  1.  W:$D(IOF) @IOF
  1.  K DDSFILE,DA,X,Y
  1.  S DA=+ACRVND
  1.  S DDSFILE="^AUTTVNDR("
  1.  D ^DDS
  1.  K DDSFILE,DA,DR,X,Y
  1.  W:$D(IOF) @IOF
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DUNS(X) ; EP;----- RETURNS DUNN AND BRADSTREET NUMBER
  1.  ;
  1.  ;      X  = VENDOR IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^AUTTVNDR(X,0)),U,7)                ;FREE TEXT
  1.  Q Y
  1.  ; ********************************************************************
  1.  ;
  1. CHKVNDR ; EP - Check if vendor is inactive, DUNS exists, and DUNS is 9-13 long
  1.  K ACRACTV,ACRVNDR,ACRDUNS,ACRINACT,ACRNODUN,ACRSIZE,ACRVERR
  1.  K ACRDERR
  1.  S ACRVNAME=$$GET1^DIQ(9999999.11,+ACRVND,.01,"E")
  1.  D ACT
  1.  D DUNSCHK
  1.  D:ACRWARN'="WARN" @ACRWARN            ;ACR*2.1*22.04 IM22759
  1.  K ACRACTV,ACRVNDR,ACRDUNS
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. ACT ; EP - Check to see if Vendor has been inactivated
  1.  S ACRVNAME=$$GET1^DIQ(9999999.11,+ACRVND,.01,"E")
  1.  S ACRACTV=$$GET1^DIQ(9999999.11,+ACRVND,.05,"E")
  1.  I ACRACTV'="" D  ;INACTIVE VENDOR
  1.  .W *7
  1.  .S ACRVERR=ACRVNAME_" is INACTIVE"
  1.  .D:$D(DDSREFT) HLP^DDSUTL(ACRVERR)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DUNSCHK ; EP - Check to see if there is a DUNS #
  1.  S ACRWARN="WARN2"
  1.  S:$D(DDSREFT) ACRWARN="WARN"   ;IF CALLED FROM SCREENMAN DO OTHER WARNING
  1.  K ACRDERR
  1.  S ACRDUNS=$$DUNS^ACRFVLK(+ACRVND)
  1.  S ACRVNAME=$$GET1^DIQ(9999999.11,+ACRVND,.01,"E")
  1.  I ACRDUNS="" D                        ;NO DUNS
  1.  .W *7
  1.  .S ACRDERR=ACRVNAME_" MUST have a DUNS number entered"
  1.  .D:$D(DDSREFT) HLP^DDSUTL(ACRDERR)
  1.  ;Check to see if the DUNS # is 9 - 13 chars long
  1.  I ACRDUNS'="" D
  1.  .I $L(ACRDUNS)<9!($L(ACRDUNS)>13)!(ACRDUNS[11111)!(ACRDUNS[99999) D  ;DUNS WRONG LENGTH
  1.  ..W *7
  1.  ..S ACRDERR=ACRVNAME_" MUST have a 9-13 digit DUNS number entered and cannot be all one number"
  1.  ..D:$D(DDSREFT) HLP^DDSUTL(ACRDERR)
  1.  Q
  1.  ;
  1. WARN ;EP; IN SM WARNING THAT VENDOR IS INACTIVE, DUNS IS MISSING OR BAD
  1.  I $D(ACRDERR)!($D(ACRVERR)) D
  1.  .W !!,$G(ACRDERR)
  1.  .W:$G(ACRDERR)]"" ! W $G(ACRVERR)
  1.  .S (ACRQUIT,ACROUT)=1
  1.  Q
  1.  ;
  1. WARN2 ;EP; WARNING THAT VENDOR IS INACTIVE, DUNS IS MISSING OR BAD
  1.  I $D(ACRDERR)!($D(ACRVERR)) D
  1.  .D WARNING^ACRFWARN
  1.  .W !!,$G(ACRDERR)
  1.  .W:$G(ACRDERR)]"" ! W $G(ACRVERR)
  1.  .W !!,"A Purchase Order or Request for Credit Card cannot be sent"
  1.  .W !,"for approval until the reported problem has been resolved"
  1.  .D PAUSE^ACRFWARN
  1.  .S (ACRQUIT,ACROUT)=1
  1.  Q
  1. AI ;EP - INVOKE SCREEN TO ALLOW ACTIVATION/INACTIVATION OF VENDOR
  1.  S ACRVAUTH=$$EDITAUTH(DUZ)
  1.  D ASKVND
  1.  Q:$D(ACRQUIT)
  1.  I ",A,C,F,"'[(","_ACRVAUTH_",") D MSG Q
  1.  S DR="[ACR VENDOR EDIT-ACT/INACT]"
  1.  D SCREEN(ACRVND,DR)
  1.  Q
  1. EINCHK ;CHECK FOR VENDORS WITH THE SAME EIN NO  ACR*2.1*21.03  IM22241
  1.  S (ACRVEIN,ACRVIEN,ACRVDUP)=""
  1.  F  S ACRVEIN=$O(^AUTTVNDR("E",ACRVEIN)) Q:'ACRVEIN  D
  1.  .Q:$E(ACRVEIN,1,10)'=X
  1.  .F  S ACRVIEN=$O(^AUTTVNDR("E",ACRVEIN,ACRVIEN)) Q:'ACRVIEN  D
  1.  .. S ACRVDUP=$$GET1^DIQ(9999999.11,ACRVIEN,.01)_"  "_$$GET1^DIQ(9999999.11,ACRVIEN,1101)
  1.  ..W *7
  1.  ..D HLP^DDSUTL(ACRVDUP_"    ALREADY EXISTS")
  1.  ..D HLP^DDSUTL("Make sure this is the correct EIN number and change if necessary")
  1.  ..D HLP^DDSUTL("$$EOP")
  1.  ..S DDSBR=6
  1.  K ACRVEIN,ACRVDUP
  1.  Q
  1. SUFCHK ;CHECK EIN SUFFIX  ACR*2.1*21.03  IM22241
  1.  K ACRSUFF
  1.  I '$D(ACREINNW) S ACREIN=$E($$GET1^DIQ(9999999.11,DA,1101))
  1.  I $D(ACREINNW) S ACREIN=$E(ACREINNW)
  1.  ;I ACREIN=1,X=""!($L(X)'=2)!(X'?2UN) D  ;BAD SUFFIX  ;ACR*2.1*22.11l
  1.  I X=""!($L(X)'=2)!(X'?2UN) D  ;BAD SUFFIX  ;ACR*2.1*22.11l
  1.  .S ACRSUFF=""
  1.  .W *7
  1.  .;D HLP^DDSUTL("Organizations MUST HAVE a SUFFIX, SUFFIX MUST BE 2 characters long, and SUFFIX MUST BE a combination of uppercase letters and numbers") ;ACR*2.1*22.11l
  1.  .D HLP^DDSUTL("ALL VENDORS MUST HAVE a SUFFIX, MUST BE 2 characters long, and MUST BE a combination of uppercase letters and numbers")  ;ACR*2.1*22.11l
  1.  .D HLP^DDSUTL("$$EOP")
  1.  Q:X=""
  1.  S (ACRVIEN,ACRVEIN,ACRVDUP)=""
  1.  I '$D(ACREINNW) S ACRVEIN=$$GET1^DIQ(9999999.11,DA,1101)_X
  1.  I $D(ACREINNW) S ACRVEIN=ACREINNW_X
  1.  F  S ACRVIEN=$O(^AUTTVNDR("E",ACRVEIN,ACRVIEN)) Q:'ACRVIEN  D
  1.  .Q:ACRVIEN=DA                         ;ACR*2.1*22.11h IM22761
  1.  .S ACRVDUP=$$GET1^DIQ(9999999.11,ACRVIEN,.01)_"  "_$$GET1^DIQ(9999999.11,ACRVIEN,1102.01)
  1.  .W *7
  1.  .D HLP^DDSUTL(ACRVDUP_"    Already Exists")
  1.  .D HLP^DDSUTL("You CANNOT have vendors with the same EIN NUMBER and SUFFIX")
  1.  .D HLP^DDSUTL("Correct the EIN NUMBER or SUFFIX accordingly")
  1.  .D HLP^DDSUTL("$$EOP")
  1.  .S DDSBR=6
  1.  K ACRVIEN,ACRVEIN,ACRVDUP
  1.  Q