GECSUNUM ;WISC/RFJ-get next counter number ;01 Nov 93
;;2.0;GCS;**34**;MAR 14, 1995
Q
;
;
COUNTER(GECSNAME) ; return next counter number
; gecsname=station-batch type-fiscal year
; example for fms: 460-FMS:MO-94
; return next counter number
I $L($G(GECSNAME))<10!($L($G(GECSNAME))>20) Q "invalid format for "_$G(GECSNAME)
N %,DA
;
S DA=+$O(^GECS(2101.5,"B",GECSNAME,0))
I 'DA D
. ; add entry to file
. L +^GECS(2101.5,0)
. ; check to make sure another job did not add entry between locks
. S DA=+$O(^GECS(2101.5,"B",GECSNAME,0)) I DA Q
. S %=^GECS(2101.5,0)
. F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2101.5,DA))
. S ^GECS(2101.5,DA,0)=GECSNAME_"^0"
. S ^GECS(2101.5,"B",GECSNAME,DA)=""
. S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2101.5,0)=%
. L -^GECS(2101.5,0)
;
L +^GECS(2101.5,DA)
S %=$P(^GECS(2101.5,DA,0),"^",2)+1
I %>9999999 S %=1
I %=0 S %=1
S $P(^GECS(2101.5,DA,0),"^",2)=%
L -^GECS(2101.5,DA)
Q %
;
ACOUNTER(GECSNAME) ; return next alphanumeric counter number
; gecsname=station-batch type-fiscal year
; example for fms: 460-FMS:MO-94
; return next alphanumeric counter number
I $L($G(GECSNAME))<10!($L($G(GECSNAME))>20) Q "invalid format for "_$G(GECSNAME)
N %,DA,GECALPHA,GECCNT,X1,X2,X3
;
S GECALPHA="ABCDEFGHIJKLMNPQRSTUVWXYZA"
S DA=+$O(^GECS(2101.5,"B",GECSNAME,0))
I 'DA D
. ; add entry to file
. L +^GECS(2101.5,0)
. ; check to make sure another job did not add entry between locks
. S DA=+$O(^GECS(2101.5,"B",GECSNAME,0)) I DA Q
. S %=^GECS(2101.5,0)
. F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2101.5,DA))
. S ^GECS(2101.5,DA,0)=GECSNAME_"^0"
. S ^GECS(2101.5,"B",GECSNAME,DA)=""
. S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2101.5,0)=%
. L -^GECS(2101.5,0)
;
L +^GECS(2101.5,DA)
S %=$P(^GECS(2101.5,DA,0),"^",2)
I %?1N2A D G ACNTEND
. I %="9ZZ"!(%="9zz") S %=1 Q ;Highest value reached, start over at 1
. S X3=$E(%,3)
. S X2=$E(%,2)
. S X1=$E(%,1)
. S X3=$$ALPHA(X3) ;increment 3rd digit alpha
. I X3="A" D ;if 3rd digit alpha equal "A", then increment 2nd digit alpha
.. S X2=$$ALPHA(X2) ; increment 2nd digit alpha
.. I X2="A" S X1=X1+1 ;if 2nd digit alpha equal "A", then increase 1st digit number
. S %=X1_X2_X3
I %?2N1A D G ACNTEND
. I %="99Z"!(%="99z") S %="0AA" Q ;Highest value reached, begin using alpha for 2nd digit
. S X3=$E(%,3)
. S GECCNT=$E(%,1,2)+1 ; increment number by 1
. I GECCNT>99 S GECCNT="00" D ;reset cnt to zero and increment 3rd digit alpha
.. S X3=$$ALPHA(X3) ;increment 3rd digit alpha
. I $L(GECCNT)=1 S GECCNT="0"_GECCNT
. S %=GECCNT_X3
S %=%+1
I %>999 S %="00A" ;Highest all numeric value reached, begin using alpha as 3rd digit
ACNTEND S $P(^GECS(2101.5,DA,0),"^",2)=%
L -^GECS(2101.5,DA)
Q %
;
ALPHA(A) ;Increment alpha character to next letter in the alphabet
; A = Any letter in the alphabet except O to prevent confusion with zero
N X,Y
I A'?1A!(A="") Q "Z" ;when in doubt return "Z"
S X=A X ^%ZOSF("UPPERCASE") S A=Y
I A="O" Q "P"
S A=$E(GECALPHA,$F(GECALPHA,A))
Q A
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSUNUM 3176 printed Oct 16, 2024@17:57:23 Page 2
GECSUNUM ;WISC/RFJ-get next counter number ;01 Nov 93
+1 ;;2.0;GCS;**34**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
COUNTER(GECSNAME) ; return next counter number
+1 ; gecsname=station-batch type-fiscal year
+2 ; example for fms: 460-FMS:MO-94
+3 ; return next counter number
+4 IF $LENGTH($GET(GECSNAME))<10!($LENGTH($GET(GECSNAME))>20)
QUIT "invalid format for "_$GET(GECSNAME)
+5 NEW %,DA
+6 ;
+7 SET DA=+$ORDER(^GECS(2101.5,"B",GECSNAME,0))
+8 IF 'DA
Begin DoDot:1
+9 ; add entry to file
+10 LOCK +^GECS(2101.5,0)
+11 ; check to make sure another job did not add entry between locks
+12 SET DA=+$ORDER(^GECS(2101.5,"B",GECSNAME,0))
IF DA
QUIT
+13 SET %=^GECS(2101.5,0)
+14 FOR DA=$PIECE(%,"^",3)+1:1
if '$DATA(^GECS(2101.5,DA))
QUIT
+15 SET ^GECS(2101.5,DA,0)=GECSNAME_"^0"
+16 SET ^GECS(2101.5,"B",GECSNAME,DA)=""
+17 SET $PIECE(%,"^",3)=DA
SET $PIECE(%,"^",4)=$PIECE(%,"^",4)+1
SET ^GECS(2101.5,0)=%
+18 LOCK -^GECS(2101.5,0)
End DoDot:1
+19 ;
+20 LOCK +^GECS(2101.5,DA)
+21 SET %=$PIECE(^GECS(2101.5,DA,0),"^",2)+1
+22 IF %>9999999
SET %=1
+23 IF %=0
SET %=1
+24 SET $PIECE(^GECS(2101.5,DA,0),"^",2)=%
+25 LOCK -^GECS(2101.5,DA)
+26 QUIT %
+27 ;
ACOUNTER(GECSNAME) ; return next alphanumeric counter number
+1 ; gecsname=station-batch type-fiscal year
+2 ; example for fms: 460-FMS:MO-94
+3 ; return next alphanumeric counter number
+4 IF $LENGTH($GET(GECSNAME))<10!($LENGTH($GET(GECSNAME))>20)
QUIT "invalid format for "_$GET(GECSNAME)
+5 NEW %,DA,GECALPHA,GECCNT,X1,X2,X3
+6 ;
+7 SET GECALPHA="ABCDEFGHIJKLMNPQRSTUVWXYZA"
+8 SET DA=+$ORDER(^GECS(2101.5,"B",GECSNAME,0))
+9 IF 'DA
Begin DoDot:1
+10 ; add entry to file
+11 LOCK +^GECS(2101.5,0)
+12 ; check to make sure another job did not add entry between locks
+13 SET DA=+$ORDER(^GECS(2101.5,"B",GECSNAME,0))
IF DA
QUIT
+14 SET %=^GECS(2101.5,0)
+15 FOR DA=$PIECE(%,"^",3)+1:1
if '$DATA(^GECS(2101.5,DA))
QUIT
+16 SET ^GECS(2101.5,DA,0)=GECSNAME_"^0"
+17 SET ^GECS(2101.5,"B",GECSNAME,DA)=""
+18 SET $PIECE(%,"^",3)=DA
SET $PIECE(%,"^",4)=$PIECE(%,"^",4)+1
SET ^GECS(2101.5,0)=%
+19 LOCK -^GECS(2101.5,0)
End DoDot:1
+20 ;
+21 LOCK +^GECS(2101.5,DA)
+22 SET %=$PIECE(^GECS(2101.5,DA,0),"^",2)
+23 IF %?1N2A
Begin DoDot:1
+24 ;Highest value reached, start over at 1
IF %="9ZZ"!(%="9zz")
SET %=1
QUIT
+25 SET X3=$EXTRACT(%,3)
+26 SET X2=$EXTRACT(%,2)
+27 SET X1=$EXTRACT(%,1)
+28 ;increment 3rd digit alpha
SET X3=$$ALPHA(X3)
+29 ;if 3rd digit alpha equal "A", then increment 2nd digit alpha
IF X3="A"
Begin DoDot:2
+30 ; increment 2nd digit alpha
SET X2=$$ALPHA(X2)
+31 ;if 2nd digit alpha equal "A", then increase 1st digit number
IF X2="A"
SET X1=X1+1
End DoDot:2
+32 SET %=X1_X2_X3
End DoDot:1
GOTO ACNTEND
+33 IF %?2N1A
Begin DoDot:1
+34 ;Highest value reached, begin using alpha for 2nd digit
IF %="99Z"!(%="99z")
SET %="0AA"
QUIT
+35 SET X3=$EXTRACT(%,3)
+36 ; increment number by 1
SET GECCNT=$EXTRACT(%,1,2)+1
+37 ;reset cnt to zero and increment 3rd digit alpha
IF GECCNT>99
SET GECCNT="00"
Begin DoDot:2
+38 ;increment 3rd digit alpha
SET X3=$$ALPHA(X3)
End DoDot:2
+39 IF $LENGTH(GECCNT)=1
SET GECCNT="0"_GECCNT
+40 SET %=GECCNT_X3
End DoDot:1
GOTO ACNTEND
+41 SET %=%+1
+42 ;Highest all numeric value reached, begin using alpha as 3rd digit
IF %>999
SET %="00A"
ACNTEND SET $PIECE(^GECS(2101.5,DA,0),"^",2)=%
+1 LOCK -^GECS(2101.5,DA)
+2 QUIT %
+3 ;
ALPHA(A) ;Increment alpha character to next letter in the alphabet
+1 ; A = Any letter in the alphabet except O to prevent confusion with zero
+2 NEW X,Y
+3 ;when in doubt return "Z"
IF A'?1A!(A="")
QUIT "Z"
+4 SET X=A
XECUTE ^%ZOSF("UPPERCASE")
SET A=Y
+5 IF A="O"
QUIT "P"
+6 SET A=$EXTRACT(GECALPHA,$FIND(GECALPHA,A))
+7 QUIT A
