source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSUNUM.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.0 KB
RevLine 
[613]1GECSUNUM ;WISC/RFJ-get next counter number ;01 Nov 93
2 ;;2.0;GCS;**34**;MAR 14, 1995
3 Q
4 ;
5 ;
6COUNTER(GECSNAME) ; return next counter number
7 ; gecsname=station-batch type-fiscal year
8 ; example for fms: 460-FMS:MO-94
9 ; return next counter number
10 I $L($G(GECSNAME))<10!($L($G(GECSNAME))>20) Q "invalid format for "_$G(GECSNAME)
11 N %,DA
12 ;
13 S DA=+$O(^GECS(2101.5,"B",GECSNAME,0))
14 I 'DA D
15 . ; add entry to file
16 . L +^GECS(2101.5,0)
17 . ; check to make sure another job did not add entry between locks
18 . S DA=+$O(^GECS(2101.5,"B",GECSNAME,0)) I DA Q
19 . S %=^GECS(2101.5,0)
20 . F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2101.5,DA))
21 . S ^GECS(2101.5,DA,0)=GECSNAME_"^0"
22 . S ^GECS(2101.5,"B",GECSNAME,DA)=""
23 . S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2101.5,0)=%
24 . L -^GECS(2101.5,0)
25 ;
26 L +^GECS(2101.5,DA)
27 S %=$P(^GECS(2101.5,DA,0),"^",2)+1
28 I %>9999999 S %=1
29 I %=0 S %=1
30 S $P(^GECS(2101.5,DA,0),"^",2)=%
31 L -^GECS(2101.5,DA)
32 Q %
33 ;
34ACOUNTER(GECSNAME) ; return next alphanumeric counter number
35 ; gecsname=station-batch type-fiscal year
36 ; example for fms: 460-FMS:MO-94
37 ; return next alphanumeric counter number
38 I $L($G(GECSNAME))<10!($L($G(GECSNAME))>20) Q "invalid format for "_$G(GECSNAME)
39 N %,DA,GECALPHA,GECCNT,X1,X2,X3
40 ;
41 S GECALPHA="ABCDEFGHIJKLMNPQRSTUVWXYZA"
42 S DA=+$O(^GECS(2101.5,"B",GECSNAME,0))
43 I 'DA D
44 . ; add entry to file
45 . L +^GECS(2101.5,0)
46 . ; check to make sure another job did not add entry between locks
47 . S DA=+$O(^GECS(2101.5,"B",GECSNAME,0)) I DA Q
48 . S %=^GECS(2101.5,0)
49 . F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2101.5,DA))
50 . S ^GECS(2101.5,DA,0)=GECSNAME_"^0"
51 . S ^GECS(2101.5,"B",GECSNAME,DA)=""
52 . S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2101.5,0)=%
53 . L -^GECS(2101.5,0)
54 ;
55 L +^GECS(2101.5,DA)
56 S %=$P(^GECS(2101.5,DA,0),"^",2)
57 I %?1N2A D G ACNTEND
58 . I %="9ZZ"!(%="9zz") S %=1 Q ;Highest value reached, start over at 1
59 . S X3=$E(%,3)
60 . S X2=$E(%,2)
61 . S X1=$E(%,1)
62 . S X3=$$ALPHA(X3) ;increment 3rd digit alpha
63 . I X3="A" D ;if 3rd digit alpha equal "A", then increment 2nd digit alpha
64 .. S X2=$$ALPHA(X2) ; increment 2nd digit alpha
65 .. I X2="A" S X1=X1+1 ;if 2nd digit alpha equal "A", then increase 1st digit number
66 . S %=X1_X2_X3
67 I %?2N1A D G ACNTEND
68 . I %="99Z"!(%="99z") S %="0AA" Q ;Highest value reached, begin using alpha for 2nd digit
69 . S X3=$E(%,3)
70 . S GECCNT=$E(%,1,2)+1 ; increment number by 1
71 . I GECCNT>99 S GECCNT="00" D ;reset cnt to zero and increment 3rd digit alpha
72 .. S X3=$$ALPHA(X3) ;increment 3rd digit alpha
73 . I $L(GECCNT)=1 S GECCNT="0"_GECCNT
74 . S %=GECCNT_X3
75 S %=%+1
76 I %>999 S %="00A" ;Highest all numeric value reached, begin using alpha as 3rd digit
77ACNTEND S $P(^GECS(2101.5,DA,0),"^",2)=%
78 L -^GECS(2101.5,DA)
79 Q %
80 ;
81ALPHA(A) ;Increment alpha character to next letter in the alphabet
82 ; A = Any letter in the alphabet except O to prevent confusion with zero
83 N X,Y
84 I A'?1A!(A="") Q "Z" ;when in doubt return "Z"
85 S X=A X ^%ZOSF("UPPERCASE") S A=Y
86 I A="O" Q "P"
87 S A=$E(GECALPHA,$F(GECALPHA,A))
88 Q A
Note: See TracBrowser for help on using the repository browser.