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

AUTTVLK.m

Go to the documentation of this file. 
  1. AUTTVLK ; IHS/DIRM/JDM/DFM - VENDOR FILE INTERFACE ; [ 03/04/98   8:10 AM ]
  1.  ;;98.1;IHS DICTIONARIES (POINTERS);;MAR 04, 1998;Build 6
  1.  ;
  1.  ; Screen for association between the Vendor and the PACKAGE when a
  1.  ; non-LAYGOed Vendor lookup being performed and trigger to create
  1.  ; Vendor/PACKAGE association when new Vendor added by package.
  1.  ;
  1.  ;
  1. EN ;EP - Check relation between Vendor and Package.
  1.  I $D(DIC(0)),DIC(0)'["L" D EN1
  1. EXIT ;
  1.  D KILL
  1.  I $D(DICR(1,1)),DICR(1,1)'=DIC Q
  1.  G IX^DIC
  1. QUIT ;
  1.  Q
  1.  ;
  1. KILL ;
  1.  KILL AUT,AUTQUIT,AUTX,AUTY,AUTZ,AUTDIC
  1.  Q
  1.  ;
  1. EN1 ;EP - Set DIC("S") to check relation between Vendor and Package.
  1.  Q
  1.  Q:'$D(XQY0)
  1.  I $D(DIC(0)),DIC(0)["L" Q
  1.  D PACKAGE
  1.  I $D(AUTZ),AUTZ,$D(^DIC(9.4,AUTZ,0)) S AUTDIC("S")=" I $D(^AUTTVNDR(+Y,20,""B"","_AUTZ_"))" S:'$D(DIC("S")) DIC("S")=AUTDIC("S") S:DIC("S")'["AUTTVNDR(+Y,20" DIC("S")=DIC("S")_AUTDIC("S")
  1.  D KILL
  1.  Q
  1.  ;
  1. PACKAGE ;  -Determine Package.
  1.  Q:'$D(XQY0)
  1.  S AUTX=$P(XQY0,U)
  1.  F AUT=4,3,2 S AUTY=$E(AUTX,1,AUT),AUTZ=$O(^DIC(9.4,"C",AUTY,0)) D:AUTZ  Q:'$D(X)!$D(AUTQUIT)
  1.  .I $O(^DIC(9.4,"C",AUTY,AUTZ)) W !!,*7,*7,"There appears to be an error in the PACKAGE file.",!,"Please report this to your site manager." H 3 K X Q
  1.  .I $D(^DIC(9.4,AUTZ,0)),$P(^(0),U,2)=AUTY S AUTQUIT=""
  1.  KILL AUTQUIT
  1.  Q
  1.  ;
  1. TRIGGER ;EP - Set relation between Vendor and Contractor.
  1.  Q
  1.  D PACKAGE
  1. T ;
  1.  I $D(AUTZ),AUTZ,'$D(^AUTTVNDR(DA,20,"B",AUTZ)) D T1
  1.  D KILL
  1.  Q
  1.  ;
  1. T1 ;
  1.  Q:$D(^AUTTVNDR(DA,20,"B",AUTZ))
  1.  S:'$D(^AUTTVNDR(DA,20,0)) ^AUTTVNDR(DA,20,0)="^9999999.112001P"
  1.  ;EXCLUSIVE NEW BELOW REQUIRED FOR RECURSIVE FILEMAN CALL
  1.  NEW (U,DA,DUZ,DT,IO,DTIME,AUTZ)
  1.  S X=AUTZ,(AUTTDA,DA(1))=DA,DIC="^AUTTVNDR("_DA_",20,",DIC(0)="L",DIC("DR")=".02////"_DT_";.03////A"
  1.  D FILE
  1.  S DA=AUTTDA
  1.  Q
  1.  ;
  1. UP ;EP - TEMP UTILITY TO UPDATE ALL VENDORS AS CHS VENDORS AND SELECTED
  1.  ;VENDORS AS CIS VENDORS
  1.  S AUTZ=$O(^DIC(9.4,"C","ACHS",0))
  1.  I AUTZ,$D(^DIC(9.4,AUTZ,0)),'$O(^DIC(9.4,"C","ACHS",AUTZ)) S Y=0 F  S Y=$O(^AUTTVNDR(Y)) Q:'Y  S DA=Y D T
  1.  S AUTZ=$O(^DIC(9.4,"C","ACG",0))
  1.  I AUTZ,$D(^DIC(9.4,AUTZ,0)),'$O(^DIC(9.4,"C","ACG",AUTZ)) S Y=0 F  S Y=$O(^ACGS("H",Y)) Q:'Y  S DA=Y D T
  1.  Q
  1.  ;
  1. ADD ;EP - Add or Edit Vendor data.
  1.  D ^XBKVAR
  1.  F  D ADD1 Q:$D(AUTQUIT)
  1. ADDEXIT ;
  1.  KILL AUTQUIT,AUTI,AUTVENAM,AUTDA
  1.  Q
  1.  ;
  1. ADD1 ;
  1.  W:$D(IOF) @IOF
  1.  W !!?22,"ADD OR EDIT VENDOR DATA",!?21,"|==============================|"
  1.  S (DIC,DIE)="^AUTTVNDR(",DIC(0)="AELMQZ",DIC("A")="VENDOR..............: "
  1.  D DIC
  1.  I U[$E(X)!(+Y<1) S AUTQUIT="" Q
  1.  S AUTDA=+Y,AUTY=$P(Y,U,3),AUTVENAM=$P(^AUTTVNDR(+Y,0),U),AUTVEEIN=$P($G(^(11)),U,13)
  1.  F  D EN2 Q:$D(AUTQUIT)
  1.  KILL AUTQUIT
  1.  Q
  1.  ;
  1. EN2 ;
  1.  D:AUTY=1 EN3
  1.  D VND
  1.  S DIR(0)="YO",DIR("A")="Edit VENDOR DATA",DIR("B")="NO"
  1.  W !
  1.  D DIR
  1.  I $G(Y)'=1 S AUTQUIT="" Q
  1.  D EN3
  1.  Q
  1.  ;
  1. ENX ;EP - TO UPDATE THE PACKAGE MULTIPLE FROM AN EXTERNAL PACKAGE
  1.  ;MUST BE CALLED WITH THE VARIABLE 'AUTDA' SET TO THE INTERNAL ENTRY
  1.  ;NUMBER OF THE VENDOR
  1. MAKE ;
  1.  Q:'$G(AUTDA)
  1.  D PACKAGE
  1.  I $G(AUTZ),'$D(^AUTTVNDR(AUTDA,20,"B",AUTZ)),$D(^DIC(9.4,AUTZ,0)) S AUTZ=$P(^(0),U),DIR(0)="YO",DIR("A")="Make this an "_AUTZ_" vendor",DIR("B")="YES" D DIR I Y=1 S DA=AUTDA D TRIGGER
  1.  S AUTQUIT=""
  1.  Q
  1.  ;
  1. EN3 ;
  1.  S DIR(0)="SO^1:ALL Vendor Data;2:Mailing Address;3:Billing Address;4:Remit To Address;5:1099 Payment Data;6:ARMS/CIS;7:SMALL PURCHASE INFORMATION Data",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.  Q:'$G(Y)
  1.  S AUTY="",DIE="^AUTTVNDR(",DA=AUTDA,DR="[AUT VENDOR EDIT"_$S(Y=1:"",Y=2:"-MAIL]",Y=3:"-BILL",Y=4:"-REMIT",Y=5:"-PAY",Y=6:"-CIS",Y=7:"-SPIS")_"]"
  1.  W !!
  1.  D DIE
  1.  KILL AUTDDIE,AUTMESS
  1.  Q
  1.  ;
  1. VND ;
  1.  W:$D(IOF) @IOF
  1.  W ?9,"VENDOR DATA FOR: ",AUTVENAM,!
  1.  KILL DXS,DIP
  1.  NEW D0
  1.  S D0=AUTDA
  1.  D ^AUTPVND
  1.  KILL DXS,DIP
  1.  Q
  1.  ;
  1. DIC ;EP
  1.  D ^DIC
  1.  KILL DIC,DA,DD,DR,DINUM,D
  1.  Q
  1.  ;
  1. DIE ;EP
  1.  KILL AUTQUIT
  1.  LOCK +@(DIE_DA_")"):4
  1.  E  S AUTQUIT="" I $D(IOST),$E(IOST,1,2)="C-" W !!,"Entry being edited by another user.  Please try Later." H 3
  1.  Q:$D(AUTQUIT)
  1.  S AUTDIEDA=DA
  1.  D ^DIE
  1.  LOCK -@(DIE_AUTDIEDA_")")
  1.  I $D(DTOUT)!$D(DUOUT) S AUTQUIT=""
  1.  KILL DIE,DA,DR,AUTDIEDA
  1.  Q
  1.  ;
  1. FILE ;EP
  1.  KILL DD,DO
  1.  D FILE^DICN
  1.  KILL DIC,DA,DD,DR,DINUM
  1.  Q
  1.  ;
  1. DIR ;EP;
  1.  KILL AUTOUT,AUTQUIT
  1.  D ^DIR
  1.  S AUTY=Y
  1.  S:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT) AUTQUIT=""
  1.  KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT
  1.  Q
  1.  ;
  1. 1820 ;EP;TO TRANSFER DATA FROM THE 18 TO 20 NODES DUE TO CHANGE IN DB
  1.  D ^XBKVAR
  1.  S DA=0
  1.  F  S DA=$O(^AUTTVNDR(DA)) Q:'DA  I $D(^AUTTVNDR(DA,18)) S %X="^AUTTVNDR("_DA_",18,",%Y="^AUTTVNDR("_DA_",20," D %XY^%RCR S $P(^AUTTVNDR(DA,20,0),U,2)="9999999.112001P" ;K ^AUTTVNDR(DA,18)
  1.  Q
  1.  ;