| 1 | PRCHAM8 ;WISC/RHD,AKS-AMENDMENTS TO P.O. ASKER & SIGNER ;
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ASK(PRCHPO,PRCHAN) ;Ask user for their Esig
|
|---|
| 6 | ;USAGE: $$ASK^PRCHAM8(PODA,AN)
|
|---|
| 7 | ;PRCHPO is internal PO number
|
|---|
| 8 | ;PRCHAN is internal amendment number
|
|---|
| 9 | ;RETURN is the return value passed back to caller, 0=FAIL 1=SUCCESS
|
|---|
| 10 | ;P is the pointer of who was assigned to the amendment
|
|---|
| 11 | ;PNAM is the name of the person identified by P in file 200
|
|---|
| 12 | N P,PRCSIG,ROUTINE
|
|---|
| 13 | S RETURN=0,P=+$G(^PRC(443.6,PRCHPO,6,PRCHAN,1))
|
|---|
| 14 | I P<1 W !?5,"Purchasing Agent Field is undefined !",$C(7) Q RETURN
|
|---|
| 15 | I P'=DUZ D Q RETURN
|
|---|
| 16 | .N PNAM S PNAM=$P($G(^VA(200,P,0)),"^",1)
|
|---|
| 17 | .W !?5,PNAM," was assigned to this Amendment."
|
|---|
| 18 | .W !?5,"Either have them sign the Amendment or"
|
|---|
| 19 | .W !?5,"reassign the Amendment to yourself.",$C(7)
|
|---|
| 20 | .Q
|
|---|
| 21 | S PRCSIG="" D ESIG^PRCUESIG(P,.PRCSIG) I PRCSIG<1 W !?5,"<NO ACTION TAKEN>" S ROUTINE="PRCUESIG" D QQ Q RETURN
|
|---|
| 22 | S RETURN=1
|
|---|
| 23 | Q RETURN
|
|---|
| 24 | ;
|
|---|
| 25 | COMMIT(PRCHPO,PRCHAN,RETURN) ;put on validation code
|
|---|
| 26 | ;USAGE: D COMMIT^PRCHAM8(PODA,AN,.Y) then check Y value
|
|---|
| 27 | ;PRCHPO is internal PO number
|
|---|
| 28 | ;PRCHAN is internal amendment number
|
|---|
| 29 | ;RETURN is the return value passed back to caller, 0=FAIL 1=SUCCESS
|
|---|
| 30 | ;DO NOT 'NEW' THE VARIABLE 'RETURN' IN HERE
|
|---|
| 31 | ; SINCE IT IS PASSED BACK TO CALLING ROUTINE!
|
|---|
| 32 | N PRCSUM,PRCSIG,ROUTINE
|
|---|
| 33 | S RETURN=0
|
|---|
| 34 | Q:'$D(^PRC(442,PRCHPO,0)) RETURN
|
|---|
| 35 | Q:'$D(^PRC(443.6,PRCHPO,0)) RETURN
|
|---|
| 36 | S PRCSUM=$$SUM^PRCUESIG(PRCHPO_"^"_$$STRING^PRCHES5(^PRC(442,PRCHPO,0),^PRC(442,PRCHPO,1),^PRC(442,PRCHPO,12)))
|
|---|
| 37 | S PRCSIG="" D ENCODE^PRCHES10(PRCHPO,PRCHAN,DUZ,.PRCSIG) S ROUTINE="PRCHMA" I PRCSIG<1 G QQ
|
|---|
| 38 | ;S X=$P(^PRC(443.6,PRCHPO,6,PRCHAN,1),U,4) S:X]"" $P(^PRC(443.6,PRCHPO,7),U,1)=X
|
|---|
| 39 | S PRCSIG="" D RECODE^PRCHES12(PRCHPO,PRCSUM,.PRCSIG) S ROUTINE="PRCHMA" I PRCSIG<1 G QQ
|
|---|
| 40 | S RETURN=1
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | QQ ;error reporter
|
|---|
| 44 | N DIR
|
|---|
| 45 | S:'$D(ROUTINE) ROUTINE=$T(+0)
|
|---|
| 46 | W !!,$$ERR^PRCHQQ(ROUTINE,PRCSIG) W:PRCSIG=0!(PRCSIG=-3) !,"Notify Application Coordinator!"
|
|---|
| 47 | S DIR(0)="EAO",DIR("A")="Press <Return> to continue " D ^DIR
|
|---|
| 48 | Q
|
|---|
