| [613] | 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
 | 
|---|