- 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 Feb 18, 2025@23:22:58 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