Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GECSUNUM

GECSUNUM.m

Go to the documentation of this file.
  1. GECSUNUM ;WISC/RFJ-get next counter number ;01 Nov 93
  1. ;;2.0;GCS;**34**;MAR 14, 1995
  1. Q
  1. ;
  1. ;
  1. COUNTER(GECSNAME) ; return next counter number
  1. ; gecsname=station-batch type-fiscal year
  1. ; example for fms: 460-FMS:MO-94
  1. ; return next counter number
  1. I $L($G(GECSNAME))<10!($L($G(GECSNAME))>20) Q "invalid format for "_$G(GECSNAME)
  1. N %,DA
  1. ;
  1. S DA=+$O(^GECS(2101.5,"B",GECSNAME,0))
  1. I 'DA D
  1. . ; add entry to file
  1. . L +^GECS(2101.5,0)
  1. . ; check to make sure another job did not add entry between locks
  1. . S DA=+$O(^GECS(2101.5,"B",GECSNAME,0)) I DA Q
  1. . S %=^GECS(2101.5,0)
  1. . F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2101.5,DA))
  1. . S ^GECS(2101.5,DA,0)=GECSNAME_"^0"
  1. . S ^GECS(2101.5,"B",GECSNAME,DA)=""
  1. . S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2101.5,0)=%
  1. . L -^GECS(2101.5,0)
  1. ;
  1. L +^GECS(2101.5,DA)
  1. S %=$P(^GECS(2101.5,DA,0),"^",2)+1
  1. I %>9999999 S %=1
  1. I %=0 S %=1
  1. S $P(^GECS(2101.5,DA,0),"^",2)=%
  1. L -^GECS(2101.5,DA)
  1. Q %
  1. ;
  1. ACOUNTER(GECSNAME) ; return next alphanumeric counter number
  1. ; gecsname=station-batch type-fiscal year
  1. ; example for fms: 460-FMS:MO-94
  1. ; return next alphanumeric counter number
  1. I $L($G(GECSNAME))<10!($L($G(GECSNAME))>20) Q "invalid format for "_$G(GECSNAME)
  1. N %,DA,GECALPHA,GECCNT,X1,X2,X3
  1. ;
  1. S GECALPHA="ABCDEFGHIJKLMNPQRSTUVWXYZA"
  1. S DA=+$O(^GECS(2101.5,"B",GECSNAME,0))
  1. I 'DA D
  1. . ; add entry to file
  1. . L +^GECS(2101.5,0)
  1. . ; check to make sure another job did not add entry between locks
  1. . S DA=+$O(^GECS(2101.5,"B",GECSNAME,0)) I DA Q
  1. . S %=^GECS(2101.5,0)
  1. . F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2101.5,DA))
  1. . S ^GECS(2101.5,DA,0)=GECSNAME_"^0"
  1. . S ^GECS(2101.5,"B",GECSNAME,DA)=""
  1. . S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2101.5,0)=%
  1. . L -^GECS(2101.5,0)
  1. ;
  1. L +^GECS(2101.5,DA)
  1. S %=$P(^GECS(2101.5,DA,0),"^",2)
  1. I %?1N2A D G ACNTEND
  1. . I %="9ZZ"!(%="9zz") S %=1 Q ;Highest value reached, start over at 1
  1. . S X3=$E(%,3)
  1. . S X2=$E(%,2)
  1. . S X1=$E(%,1)
  1. . S X3=$$ALPHA(X3) ;increment 3rd digit alpha
  1. . I X3="A" D ;if 3rd digit alpha equal "A", then increment 2nd digit alpha
  1. .. S X2=$$ALPHA(X2) ; increment 2nd digit alpha
  1. .. I X2="A" S X1=X1+1 ;if 2nd digit alpha equal "A", then increase 1st digit number
  1. . S %=X1_X2_X3
  1. I %?2N1A D G ACNTEND
  1. . I %="99Z"!(%="99z") S %="0AA" Q ;Highest value reached, begin using alpha for 2nd digit
  1. . S X3=$E(%,3)
  1. . S GECCNT=$E(%,1,2)+1 ; increment number by 1
  1. . I GECCNT>99 S GECCNT="00" D ;reset cnt to zero and increment 3rd digit alpha
  1. .. S X3=$$ALPHA(X3) ;increment 3rd digit alpha
  1. . I $L(GECCNT)=1 S GECCNT="0"_GECCNT
  1. . S %=GECCNT_X3
  1. S %=%+1
  1. I %>999 S %="00A" ;Highest all numeric value reached, begin using alpha as 3rd digit
  1. ACNTEND S $P(^GECS(2101.5,DA,0),"^",2)=%
  1. L -^GECS(2101.5,DA)
  1. Q %
  1. ;
  1. 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
  1. N X,Y
  1. I A'?1A!(A="") Q "Z" ;when in doubt return "Z"
  1. S X=A X ^%ZOSF("UPPERCASE") S A=Y
  1. I A="O" Q "P"
  1. S A=$E(GECALPHA,$F(GECALPHA,A))
  1. Q A