PRCFACP.m

PRCFACP ;WISC/CTB/BGJ-BATCH PRINT CODE SHEETS ;2/18/93  14:49

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

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

 S PRCFASYS="CLMFEEFENIRSCLI"

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

 S ZTDESC="BATCH AND PRINT CODE SHEETS",ZTRTN="V^PRCFACP1",ZTSAVE("PRC*")="",ZTSAVE("PRCFASYS")="" D ^PRCFQ Q

 Q

COUNTER ;RETREIVE NEXT COUNTER NUMBER FROM FILE 422.2  NEEDS VARIABLE X AS INPUT RETURNS NEXT NUMBER IN VARIABLE Y

 K DA S Y=-1 Q:'$D(X)  Q:X=""

 I '$D(^PRCF(422.2,"B",X)) S DIC=422.2,DIC(0)="MLX",DLAYGO=422.2 D ^DIC K DIC,DLAYGO Q:Y<0  S DA=+Y G LOCK

 S DA=$O(^PRCF(422.2,"B",X,0))

LOCK L +^PRCF(422.2,DA):60 G COUNTER:'$T S Y=$P(^PRCF(422.2,DA,0),"^",2)+1 I $D(PRCFLN),Y>PRCFLN S Y=1 K PRCFLN

 S $P(^PRCF(422.2,DA,0),"^",2)=Y L -^PRCF(422.2,DA) Q

OUT W $C(7),"  <OPTION ABORTED>" R X:5 Q

LOG S PRCFASYS="LOG" G EN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFACP   873     printed  Apr 09, 2024@21:05:42                                                                                                                                                                                                      Page 2

PRCFACP   ;WISC/CTB/BGJ-BATCH PRINT CODE SHEETS ;2/18/93  14:49

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

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

 +2        SET PRCFASYS="CLMFEEFENIRSCLI"

EN         SET PRCF("X")="AS"

           DO ^PRCFSITE

           if '%

               GOTO OUT

 +1        SET ZTDESC="BATCH AND PRINT CODE SHEETS"

           SET ZTRTN="V^PRCFACP1"

           SET ZTSAVE("PRC*")=""

           SET ZTSAVE("PRCFASYS")=""

           DO ^PRCFQ

           QUIT 

 +2        QUIT 

COUNTER   ;RETREIVE NEXT COUNTER NUMBER FROM FILE 422.2  NEEDS VARIABLE X AS INPUT RETURNS NEXT NUMBER IN VARIABLE Y

 +1        KILL DA

           SET Y=-1

           if '$DATA(X)

               QUIT 

           if X=""

               QUIT 

 +2        IF '$DATA(^PRCF(422.2,"B",X))

               SET DIC=422.2

               SET DIC(0)="MLX"

               SET DLAYGO=422.2

               DO ^DIC

               KILL DIC,DLAYGO

               if Y<0

                   QUIT 

               SET DA=+Y

               GOTO LOCK

 +3        SET DA=$ORDER(^PRCF(422.2,"B",X,0))

LOCK       LOCK +^PRCF(422.2,DA):60

           if '$TEST

               GOTO COUNTER

           SET Y=$PIECE(^PRCF(422.2,DA,0),"^",2)+1

           IF $DATA(PRCFLN)

               IF Y>PRCFLN

                   SET Y=1

                   KILL PRCFLN

 +1        SET $PIECE(^PRCF(422.2,DA,0),"^",2)=Y

           LOCK -^PRCF(422.2,DA)

           QUIT 

OUT        WRITE $CHAR(7),"  <OPTION ABORTED>"

           READ X:5

           QUIT 

LOG        SET PRCFASYS="LOG"

           GOTO EN