PRCHG1.m

PRCHG1 ;SF-ISC/TKW-PROCESS ALL ISSUE BOOK ORDERS PENDING PPM ACCOUNTABLE OFFICERS PROC/SIG--CALLED FROM PRCHG ;1/25/93  13:16

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

EN W ! S %A="PROCESS ISSUE BOOK ORDERS",%B="If you answer 'YES', this function will loop all through all Issue Book Requests",%B(1)="that are pending PPM processing, and will automatically set them to the status"

 S %B(2)="'Assigned to PPM Clerk', so that LOG code sheets can be generated by the",%B(3)="Requirements Analyst (R/A).",%=2 D YN^PRCFYN Q:%'=1

 W !!,$C(7),"Processing Issue Book Orders--Please Wait!",!!

 F DA=0:0 S DA=$O(^PRC(443,"AC",60,DA)) Q:'DA  I $D(^PRCS(410,DA,0)),$P(^(0),U,4)=5,+^(0)=PRC("SITE") D PROISS

 G Q

 ;

QQ S:'$D(ROUTINE) ROUTINE=$T(+0) W !!,$$ERR^PRCHQQ(ROUTINE,PRCSIG) W:PRCSIG=0!(PRCSIG=-3) !,"Notify Application Coordinator!",$C(7) S DIR(0)="EAO",DIR("A")="Press <return> to continue" D ^DIR

 ;

Q K PRCHES,DA,DIE,DR,ROUTINE

 Q

 ;

PROISS ;W "Transaction No.: "_$S($D(^PRCS(410,DA,0)):$P(^(0),U,1),1:""),!

 W "Transaction No.: "_$P($G(^PRCS(410,DA,0)),U,1),!

 S DIE="^PRC(443,",DR="1.5////65;9///2;10///1;13///E" D ^DIE

 S PRCSIG="" D ENCODE^PRCHES11(DA,DUZ,.PRCSIG) S ROUTINE=$T(+0) G:PRCSIG<1 QQ

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHG1   1279     printed  Apr 09, 2024@21:12:34                                                                                                                                                                                                      Page 2

PRCHG1    ;SF-ISC/TKW-PROCESS ALL ISSUE BOOK ORDERS PENDING PPM ACCOUNTABLE OFFICERS PROC/SIG--CALLED FROM PRCHG ;1/25/93  13:16

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;

EN         WRITE !

           SET %A="PROCESS ISSUE BOOK ORDERS"

           SET %B="If you answer 'YES', this function will loop all through all Issue Book Requests"

           SET %B(1)="that are pending PPM processing, and will automatically set them to the status"

 +1        SET %B(2)="'Assigned to PPM Clerk', so that LOG code sheets can be generated by the"

           SET %B(3)="Requirements Analyst (R/A)."

           SET %=2

           DO YN^PRCFYN

           if %'=1

               QUIT 

 +2        WRITE !!,$CHAR(7),"Processing Issue Book Orders--Please Wait!",!!

 +3        FOR DA=0:0

               SET DA=$ORDER(^PRC(443,"AC",60,DA))

               if 'DA

                   QUIT 

               IF $DATA(^PRCS(410,DA,0))

                   IF $PIECE(^(0),U,4)=5

                       IF +^(0)=PRC("SITE")

                           DO PROISS

 +4        GOTO Q

 +5       ;

QQ         if '$DATA(ROUTINE)

               SET ROUTINE=$TEXT(+0)

           WRITE !!,$$ERR^PRCHQQ(ROUTINE,PRCSIG)

           if PRCSIG=0!(PRCSIG=-3)

               WRITE !,"Notify Application Coordinator!",$CHAR(7)

           SET DIR(0)="EAO"

           SET DIR("A")="Press <return> to continue"

           DO ^DIR

 +1       ;

Q          KILL PRCHES,DA,DIE,DR,ROUTINE

 +1        QUIT 

 +2       ;

PROISS    ;W "Transaction No.: "_$S($D(^PRCS(410,DA,0)):$P(^(0),U,1),1:""),!

 +1        WRITE "Transaction No.: "_$PIECE($GET(^PRCS(410,DA,0)),U,1),!

 +2        SET DIE="^PRC(443,"

           SET DR="1.5////65;9///2;10///1;13///E"

           DO ^DIE

 +3        SET PRCSIG=""

           DO ENCODE^PRCHES11(DA,DUZ,.PRCSIG)

           SET ROUTINE=$TEXT(+0)

           if PRCSIG<1

               GOTO QQ

 +4        QUIT