51 lines
2.4 KiB
Mathematica
51 lines
2.4 KiB
Mathematica
PRCHCON3 ;WISC/KMB CREATE PURCHASE CARD FROM TEMP REQ ;1/8/97
|
|
;;5.1;IFCAP;**92**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
START ;
|
|
SETUP ;create 442 entry
|
|
D ENPO^PRCHUTL I '$D(DA) S OUT=1 W !,"Unable to create 442 entry. Try later." H 3 Q
|
|
SETUP1 ;
|
|
S (PRCHPO,PDA)=DA L +^PRC(442,PDA):15 E W !!,$C(7),"Another user is editing this entry, try later." K PDA Q
|
|
S DIE="^PRC(442,",DR="62////"_NDA_";"_"5.2///"_SERV_";"_".8///3" S:$G(FLAG)'=1 DR=DR_";"_".02///25"_";"_"48///P" D ^DIE
|
|
I VENDOR'="" S DR="53////"_VENDOR_";"_"5////"_VENDOR D ^DIE
|
|
I $G(FLAG)=1 S DR=".02///1"_";"_"47///Y"_";"_"48///D" D ^DIE
|
|
S $P(^PRC(442,PDA,0),"^",3)=FCP,$P(^(0),"^",5)=CCEN,$P(^(23),"^",7)=PRC("SST")
|
|
S DIE="^PRC(442,",DR=".03///"_SPEC_";"_".1///"_TDATE D ^DIE
|
|
S $P(^PRC(442,PDA,1),"^",10)=DUZ,^PRC(442,"E",CP,PDA)=""
|
|
;
|
|
S DR="52///"_CR_";"_"56///"_DUZ_";"_"63///1"_";"_"60///"_NCOST D ^DIE
|
|
S $P(^PRC(442,PDA,23),U,13)=SG
|
|
I $G(VENDOR)'="" D SETIT
|
|
E W !!,"This request has no entry in the Vendor File."
|
|
L -^PRC(442,PDA)
|
|
I $G(VENDOR)="" W !,"You must edit a request with no entry in the Vendor File.",! D LOOP1 Q
|
|
I REM1'=+$P(PRC("CP")," ") W !,"Since the control point is changed, you must edit this request." D LOOP1 Q
|
|
L +^PRC(442,PDA):15 E W !!,$C(7),"Another user is editing this entry, try later." K PDA Q
|
|
S $P(^PRC(442,PDA,1),"^")=VENDOR,$P(^(23),"^",14)=VENDOR,$P(^(23),"^",23)=NDA,^PRC(442,"D",$E(VENDOR,1,30),PDA)=""
|
|
L -^PRC(442,PDA)
|
|
D LOOP
|
|
Q
|
|
;
|
|
SETIT ; set item data on 442 record
|
|
Q:$G(CNNT)="" F II=1:1:CNNT D
|
|
.S ^PRC(442,PDA,2,II,0)=AA(II)
|
|
.I $G(CNT) F J=1:1:CNT S ^PRC(442,PDA,2,II,1,J,0)=$G(BB(II,J))
|
|
.S ^PRC(442,PDA,2,II,2)=CC(II)
|
|
.I $G(CNT) S ^PRC(442,PDA,2,II,1,0)="^^"_CNT_"^"_CNT_"^"_TDATE_"^"
|
|
.S ^PRC(442,PDA,2,"B",II,II)="",^PRC(442,PDA,2,"C",II,II)=""
|
|
.S (PRCHCI,PRCHCII,X)=$P(AA(II),U,5) Q:PRCHCI="" S (DA(1),PRCHCPO)=PDA,DA=II,PRCHCCP=CP,PRCHCPD=TDATE,PRCHCV=VENDOR D EN3^PRCHCRD S ^PRC(442,PDA,2,"AE",PRCHCII,II)=""
|
|
S ^PRC(442,PDA,2,0)="^442.01IA^"_CNNT_"^"_CNNT
|
|
K DIE
|
|
Q
|
|
LOOP ;
|
|
;Correction for NOIS ISW-0599-21097
|
|
S PRCHSY=NDA
|
|
W ! D SPRMK^PRCHNPO6 W !
|
|
;End NOIS correction
|
|
;
|
|
S %=1 W !,"Edit request ",$P(^PRC(442,PDA,0),"^") D YN^DICN G:%=0 LOOP Q:%=2
|
|
LOOP1 W @IOF S (PRCHPO,DA)=PDA,PRC("PER")=DUZ,X=1
|
|
L +^PRC(442,PDA):15 E W !!,$C(7),"Another user is editing this entry, try later." K PDA Q
|
|
D ^PRCHNPO L -^PRC(442,PDA) K PRC("PER"),X,PRCHPO
|
|
Q
|