PRCHAM8.m

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 ---PRCHAM8   2102     printed  Mar 13, 2025@21:10:30                                                                                                                                                                                                     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