- 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 Jan 18, 2025@03:03:15 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