PRCFACG.m

PRCFACG ;WISC@ALTOONA/CTB-GRAB A BATCH NUMBER ;15 Nov 90/1:28 PM

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

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

 S %A="This option reserves the next available batch number for a given station number,",%A(1)="month and batch type.  It the instructs the system that the number has"

 S %A(2)="been used and restricts further access to that number.",%A(3)="Do you wish to continue",%B="",%=1 D ^PRCFYN G Q:%'=1

 S PRCF("X")="AS" D ^PRCFSITE G:'% Q

 S %DT="AE",%DT("A")="Enter Month and Year: " D ^%DT I Y<0 W !,"NO BATCH NUMBER RESERVED" G Q

 S PMO=$E(Y,1,5)_"00" S Y=PMO D DD^%DT S MO=Y S:'$D(PRCFASYS) PRCFASYS="FEEFENIRS"

 I $D(PRCHLOG) S PRCFASYS="LOG",PTYP=5,BTYPE="LOG"

 E  S DIC=423.9,DIC(0)="AMNEZQ",DIC("S")="I PRCFASYS[$P(^(0),U,5)" D ^DIC G:Y<0 Q S PTYP=+Y,PRCFASYS=$P(Y(0),"^",5),BTYPE=$P(Y,"^",2) K DIC

 W ! S %A="RESERVE A BATCH FOR BATCH TYPE '"_BTYPE_"' IN "_MO,%B="",%=1 D ^PRCFYN I %'=1 W $C(7),"  NO BATCH SELECTED",!! R X:3 G Q

 W ! S PSN=PRC("SITE") D BATCH^PRCFACP2 W !,"BATCH NUMBER '",PBAT,"' HAS BEEN RESERVED",!!

Q K %,%DT,%H,%I,BTYPE,C,D,D0,DI,DIC,DIE,DA,DLAYGO,DR,MO,PBA,PBAT,PBATN,PMO,PRCF,PRCFASYS,PSN,PTR,PTYP,X,Y,Z Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFACG   1211     printed  Apr 09, 2024@21:19:37                                                                                                                                                                                                     Page 2

PRCFACG   ;WISC@ALTOONA/CTB-GRAB A BATCH NUMBER ;15 Nov 90/1:28 PM

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

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

 +2        SET %A="This option reserves the next available batch number for a given station number,"

           SET %A(1)="month and batch type.  It the instructs the system that the number has"

 +3        SET %A(2)="been used and restricts further access to that number."

           SET %A(3)="Do you wish to continue"

           SET %B=""

           SET %=1

           DO ^PRCFYN

           if %'=1

               GOTO Q

 +4        SET PRCF("X")="AS"

           DO ^PRCFSITE

           if '%

               GOTO Q

 +5        SET %DT="AE"

           SET %DT("A")="Enter Month and Year: "

           DO ^%DT

           IF Y<0

               WRITE !,"NO BATCH NUMBER RESERVED"

               GOTO Q

 +6        SET PMO=$EXTRACT(Y,1,5)_"00"

           SET Y=PMO

           DO DD^%DT

           SET MO=Y

           if '$DATA(PRCFASYS)

               SET PRCFASYS="FEEFENIRS"

 +7        IF $DATA(PRCHLOG)

               SET PRCFASYS="LOG"

               SET PTYP=5

               SET BTYPE="LOG"

 +8       IF '$TEST

               SET DIC=423.9

               SET DIC(0)="AMNEZQ"

               SET DIC("S")="I PRCFASYS[$P(^(0),U,5)"

               DO ^DIC

               if Y<0

                   GOTO Q

               SET PTYP=+Y

               SET PRCFASYS=$PIECE(Y(0),"^",5)

               SET BTYPE=$PIECE(Y,"^",2)

               KILL DIC

 +9        WRITE !

           SET %A="RESERVE A BATCH FOR BATCH TYPE '"_BTYPE_"' IN "_MO

           SET %B=""

           SET %=1

           DO ^PRCFYN

           IF %'=1

               WRITE $CHAR(7),"  NO BATCH SELECTED",!!

               READ X:3

               GOTO Q

 +10       WRITE !

           SET PSN=PRC("SITE")

           DO BATCH^PRCFACP2

           WRITE !,"BATCH NUMBER '",PBAT,"' HAS BEEN RESERVED",!!

Q          KILL %,%DT,%H,%I,BTYPE,C,D,D0,DI,DIC,DIE,DA,DLAYGO,DR,MO,PBA,PBAT,PBATN,PMO,PRCF,PRCFASYS,PSN,PTR,PTYP,X,Y,Z

           QUIT 

 +1        QUIT