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 ---[H[J[2J[HPRCFACP 873 printed Dec 13, 2024@02:02:03 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
