source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAM8.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1PRCHAM8 ;WISC/RHD,AKS-AMENDMENTS TO P.O. ASKER & SIGNER ;
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ASK(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 ;
25COMMIT(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 ;
43QQ ;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
Note: See TracBrowser for help on using the repository browser.