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