63 lines
3.5 KiB
Mathematica
63 lines
3.5 KiB
Mathematica
PRCBVE ;WISC@ALTOONA/CLH-ADD/EDIT CALM VENDOR FILE ;9-21-89/09:27
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;MUST PASS VARIABLE PRCB("VEN") WHICH IS INTERNAL VENDOR NUMBER
|
|
;PRC VARIABLES MUST BE SET IE. PRC("SITE")
|
|
GN ;GET TEMP NUM
|
|
D WAIT^PRCFYN S DIC="^PRCF(421.6,",DLAYGO=421.6,DIC(0)="XOLM",X=PRC("SITE")_"-"_^%ZOSF("VOL")_"-"_$J,PRCBT=0
|
|
S:'$D(COUNT) COUNT=0 D ^DIC Q:+Y<0 I +$P(Y,U,3)'=1 S COUNT=COUNT+1 Q:COUNT=3 S DIK=DIC,DA=+Y D ^DIK K DIK G GN
|
|
S PRCB("TDA")=+Y,PRCBT=1
|
|
Q
|
|
EN ;ADD VENDOR
|
|
I $D(^PRC(440,PRCB("VEN"),7)) S PRCBE=1,%A="Do you want to review the current information on this vendor",%B="",%=2 D ^PRCFYN D:%'=2 REVO
|
|
D GN S DIE=DIC,DA=PRCB("TDA"),DR="[PRCB VENDOR EDIT]"
|
|
ENV D ^DIE D REVN S %A="Is this data correct",%B="",%=1 D ^PRCFYN I %'=1 S %A="Re-edit data",%B="",%=1 D ^PRCFYN G:%=1 ENV
|
|
I '$D(^PRC(440,PRCB("VEN"),7)) S %A(1)="This vendor does not appear to have been established in CALM Vendor File",%A(2)="Do you want to establish them at this time",%B="",%=1 D ^PRCFYN G:%=1 ADVEN G SET
|
|
I $P(^PRC(440,PRCB("VEN"),7),U,10)="" S %A(1)="This vendor does not appear to have a CALM ID Number",%A(2)="Do you want to establish them to the CALM Vendor File",%B="",%=1 D ^PRCFYN G:%=1 ADVEN G SET
|
|
I $D(PRCBE) S %A="Do you want to update the CALM vendor file at this time",%B="",%=1 D ^PRCFYN G:%'=1 SET
|
|
;THIS AREA FOR UPDATING EXSITING VENDOR INFO IN CALM
|
|
ADVEN ;AREA TO SET UP MSG FOR AUSTIN TO ESTABLISH NEW VENDOR
|
|
W !!,"Twix will be sent to establish vendor: ",$P(^PRC(440,PRCB("VEN"),0),U)," in the CALM Vendor File."
|
|
SET ;MOVE TEMP INFO FROM 421.6 TO 440
|
|
W !!,"I'm going to update the your Vendor File..."
|
|
I '$D(^PRCF(421.6,PRCB("TDA"),3)) G OUT
|
|
I '$D(^PRC(440,PRCB("VEN"),7)) S OR="",$P(OR,U,1,11)=""
|
|
E S OR=$P(^PRC(440,PRCB("VEN"),7),U,1,99)
|
|
S NR=$P(^PRCF(421.6,PRCB("TDA"),3),U,1,99)
|
|
;I $P(NR,U,3)
|
|
S ^PRC(440,PRCB("VEN"),7)=$P(NR,U,12)_U_$P(NR,U,11)_U_$P(NR,U,3,9)
|
|
W !!,"Finished. Hold on while I do some clean up...."
|
|
OUT I $D(PRCB("TDA")) S DIK="^PRCF(421.6,",DA=PRCB("TDA") D ^DIK
|
|
K DIK,DIC,DIE,PRCB("TDA"),DA,X,COUNT,PRCBT,DLAYGO,%,REC,REC1,TEMP,TEMP1
|
|
Q
|
|
REVO ;REVIEW OLD VENDOR INFO
|
|
I '$D(^PRC(440,PRCB("VEN"),0)) W !!,$C(7),"** No Vendor Information available **" Q
|
|
S REC=^PRC(440,PRCB("VEN"),0) I '$D(^PRC(440,PRCB("VEN"),7)) S REC1="",$P(REC1,U,1,11)=""
|
|
E S REC1=^PRC(440,PRCB("VEN"),7)
|
|
I $D(IOF) W @IOF
|
|
W !!?5,"Vendor Name: ",$P(REC,U,1),?48,"Vendor Number: ",PRCB("VEN")
|
|
W !!!?5,"Payment Information: "
|
|
W !!?19,"Calm ID Number: " I $P(REC1,U,10)'="" W $P(REC1,U,10)
|
|
W !?19,"Stub Name: " I $P(REC1,U,11)'="" W ?35,$P(REC1,U,11)
|
|
W !?19,"Address: " I $P(REC1,U,3)'="" W ?35,$P(REC1,U,3)
|
|
I $P(REC1,U,4)'="" W !?35,$P(REC1,U,4)
|
|
I $P(REC1,U,5)'="" W !?35,$P(REC1,U,5)
|
|
I $P(REC1,U,6)'="" W !?35,$P(REC1,U,6)
|
|
I $P(REC1,U,7)'="" W !?35,$P(REC1,U,7)_", ",$P(^DIC(5,$P(REC1,U,8),0),U)_" ",$P(REC1,U,9)
|
|
W !!?19,"Phone Number: " I $P(REC1,U,2)'="" W ?35,$P(REC1,U,2)
|
|
Q
|
|
REVN ;REVIEW NEW VENDOR INFO
|
|
I '$D(^PRCF(421.6,PRCB("TDA"),3)) W !,$C(7)," - No Data Entered - " Q
|
|
E S TEMP1=^PRCF(421.6,PRCB("TDA"),3)
|
|
I $D(IOF) W @IOF
|
|
W !!?5,"Vendor Name: ",$P(^PRC(440,PRCB("VEN"),0),U)
|
|
W !!!?5,"Payment Information: "
|
|
W !!?19,"Calm ID Number: " I $P(TEMP1,U,1)'="" W $P(TEMP1,U,1)
|
|
W !?19,"Calm Stub Name: " I $P(TEMP1,U,10)'="" W ?35,$P(TEMP1,U,10)
|
|
W !?19,"Address: " I $P(TEMP1,U,3)'="" W ?35,$P(TEMP1,U,3)
|
|
I $P(TEMP1,U,4)'="" W !?35,$P(TEMP1,U,4)
|
|
I $P(TEMP1,U,5)'="" W !?35,$P(TEMP1,U,5)
|
|
I $P(TEMP1,U,6)'="" W !?35,$P(TEMP1,U,6)
|
|
I $P(TEMP1,U,7)'="" W !?35,$P(TEMP1,U,7)_", ",$P(TEMP1,U,8)_" ",$P(TEMP1,U,9)
|
|
Q
|