PRCHAM8 ;WISC/RHD,AKS-AMENDMENTS TO P.O. ASKER & SIGNER ;
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
ASK(PRCHPO,PRCHAN) ;Ask user for their Esig
;USAGE: $$ASK^PRCHAM8(PODA,AN)
;PRCHPO is internal PO number
;PRCHAN is internal amendment number
;RETURN is the return value passed back to caller, 0=FAIL 1=SUCCESS
;P is the pointer of who was assigned to the amendment
;PNAM is the name of the person identified by P in file 200
N P,PRCSIG,ROUTINE
S RETURN=0,P=+$G(^PRC(443.6,PRCHPO,6,PRCHAN,1))
I P<1 W !?5,"Purchasing Agent Field is undefined !",$C(7) Q RETURN
I P'=DUZ D Q RETURN
.N PNAM S PNAM=$P($G(^VA(200,P,0)),"^",1)
.W !?5,PNAM," was assigned to this Amendment."
.W !?5,"Either have them sign the Amendment or"
.W !?5,"reassign the Amendment to yourself.",$C(7)
.Q
S PRCSIG="" D ESIG^PRCUESIG(P,.PRCSIG) I PRCSIG<1 W !?5,"<NO ACTION TAKEN>" S ROUTINE="PRCUESIG" D QQ Q RETURN
S RETURN=1
Q RETURN
;
COMMIT(PRCHPO,PRCHAN,RETURN) ;put on validation code
;USAGE: D COMMIT^PRCHAM8(PODA,AN,.Y) then check Y value
;PRCHPO is internal PO number
;PRCHAN is internal amendment number
;RETURN is the return value passed back to caller, 0=FAIL 1=SUCCESS
;DO NOT 'NEW' THE VARIABLE 'RETURN' IN HERE
; SINCE IT IS PASSED BACK TO CALLING ROUTINE!
N PRCSUM,PRCSIG,ROUTINE
S RETURN=0
Q:'$D(^PRC(442,PRCHPO,0)) RETURN
Q:'$D(^PRC(443.6,PRCHPO,0)) RETURN
S PRCSUM=$$SUM^PRCUESIG(PRCHPO_"^"_$$STRING^PRCHES5(^PRC(442,PRCHPO,0),^PRC(442,PRCHPO,1),^PRC(442,PRCHPO,12)))
S PRCSIG="" D ENCODE^PRCHES10(PRCHPO,PRCHAN,DUZ,.PRCSIG) S ROUTINE="PRCHMA" I PRCSIG<1 G QQ
;S X=$P(^PRC(443.6,PRCHPO,6,PRCHAN,1),U,4) S:X]"" $P(^PRC(443.6,PRCHPO,7),U,1)=X
S PRCSIG="" D RECODE^PRCHES12(PRCHPO,PRCSUM,.PRCSIG) S ROUTINE="PRCHMA" I PRCSIG<1 G QQ
S RETURN=1
Q
;
QQ ;error reporter
N DIR
S:'$D(ROUTINE) ROUTINE=$T(+0)
W !!,$$ERR^PRCHQQ(ROUTINE,PRCSIG) W:PRCSIG=0!(PRCSIG=-3) !,"Notify Application Coordinator!"
S DIR(0)="EAO",DIR("A")="Press <Return> to continue " D ^DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHAM8 2102 printed Sep 23, 2025@19:41:46 Page 2
PRCHAM8 ;WISC/RHD,AKS-AMENDMENTS TO P.O. ASKER & SIGNER ;
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
ASK(PRCHPO,PRCHAN) ;Ask user for their Esig
+1 ;USAGE: $$ASK^PRCHAM8(PODA,AN)
+2 ;PRCHPO is internal PO number
+3 ;PRCHAN is internal amendment number
+4 ;RETURN is the return value passed back to caller, 0=FAIL 1=SUCCESS
+5 ;P is the pointer of who was assigned to the amendment
+6 ;PNAM is the name of the person identified by P in file 200
+7 NEW P,PRCSIG,ROUTINE
+8 SET RETURN=0
SET P=+$GET(^PRC(443.6,PRCHPO,6,PRCHAN,1))
+9 IF P<1
WRITE !?5,"Purchasing Agent Field is undefined !",$CHAR(7)
QUIT RETURN
+10 IF P'=DUZ
Begin DoDot:1
+11 NEW PNAM
SET PNAM=$PIECE($GET(^VA(200,P,0)),"^",1)
+12 WRITE !?5,PNAM," was assigned to this Amendment."
+13 WRITE !?5,"Either have them sign the Amendment or"
+14 WRITE !?5,"reassign the Amendment to yourself.",$CHAR(7)
+15 QUIT
End DoDot:1
QUIT RETURN
+16 SET PRCSIG=""
DO ESIG^PRCUESIG(P,.PRCSIG)
IF PRCSIG<1
WRITE !?5,"<NO ACTION TAKEN>"
SET ROUTINE="PRCUESIG"
DO QQ
QUIT RETURN
+17 SET RETURN=1
+18 QUIT RETURN
+19 ;
COMMIT(PRCHPO,PRCHAN,RETURN) ;put on validation code
+1 ;USAGE: D COMMIT^PRCHAM8(PODA,AN,.Y) then check Y value
+2 ;PRCHPO is internal PO number
+3 ;PRCHAN is internal amendment number
+4 ;RETURN is the return value passed back to caller, 0=FAIL 1=SUCCESS
+5 ;DO NOT 'NEW' THE VARIABLE 'RETURN' IN HERE
+6 ; SINCE IT IS PASSED BACK TO CALLING ROUTINE!
+7 NEW PRCSUM,PRCSIG,ROUTINE
+8 SET RETURN=0
+9 if '$DATA(^PRC(442,PRCHPO,0))
QUIT RETURN
+10 if '$DATA(^PRC(443.6,PRCHPO,0))
QUIT RETURN
+11 SET PRCSUM=$$SUM^PRCUESIG(PRCHPO_"^"_$$STRING^PRCHES5(^PRC(442,PRCHPO,0),^PRC(442,PRCHPO,1),^PRC(442,PRCHPO,12)))
+12 SET PRCSIG=""
DO ENCODE^PRCHES10(PRCHPO,PRCHAN,DUZ,.PRCSIG)
SET ROUTINE="PRCHMA"
IF PRCSIG<1
GOTO QQ
+13 ;S X=$P(^PRC(443.6,PRCHPO,6,PRCHAN,1),U,4) S:X]"" $P(^PRC(443.6,PRCHPO,7),U,1)=X
+14 SET PRCSIG=""
DO RECODE^PRCHES12(PRCHPO,PRCSUM,.PRCSIG)
SET ROUTINE="PRCHMA"
IF PRCSIG<1
GOTO QQ
+15 SET RETURN=1
+16 QUIT
+17 ;
QQ ;error reporter
+1 NEW DIR
+2 if '$DATA(ROUTINE)
SET ROUTINE=$TEXT(+0)
+3 WRITE !!,$$ERR^PRCHQQ(ROUTINE,PRCSIG)
if PRCSIG=0!(PRCSIG=-3)
WRITE !,"Notify Application Coordinator!"
+4 SET DIR(0)="EAO"
SET DIR("A")="Press <Return> to continue "
DO ^DIR
+5 QUIT
