1 | RCMSNUM ;WASH-ISC@ALTOONA,PA/RGY-Assign Common Numbering Series ;1/11/96 11:40 AM
|
---|
2 | V ;;4.5;Accounts Receivable;**27,114,172**;Mar 20, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | BNUM(SITE) ;Get next bill number
|
---|
5 | NEW NUM
|
---|
6 | L +^RC(342,"RCMSNUM"):15 I '$T Q "-1^Common Numbering series driver is busy"
|
---|
7 | S NUM=$P($G(^RC(342,1,0)),"^",3),SITE=$G(SITE)
|
---|
8 | I NUM="" D BNUM^PRCABJ S NUM=$P($G(^RC(342,1,0)),"^",3)
|
---|
9 | I NUM="" L -^RC(342,"RCMSNUM") Q "-1^Cannot get bill number from site parameter file"
|
---|
10 | S NUM=$$NUM^RCMSNUM(SITE,NUM)
|
---|
11 | S:NUM>0 $P(^RC(342,1,0),"^",3)=$P(NUM,"-",2)
|
---|
12 | L -^RC(342,"RCMSNUM")
|
---|
13 | Q NUM
|
---|
14 | ;
|
---|
15 | ;
|
---|
16 | ENUM(SITE) ;Get next event number
|
---|
17 | NEW NUM
|
---|
18 | L +^RC(342,"RCMSNUM"):15 I '$T Q "-1^Common Numbering series driver is busy"
|
---|
19 | S NUM=$P($G(^RC(342,1,0)),"^",6),SITE=$G(SITE)
|
---|
20 | I NUM="" D ENUM^PRCABJ S NUM=$P($G(^RC(342,1,0)),"^",6)
|
---|
21 | I NUM="" L -^RC(342,"RCMSNUM") Q "-1^Cannot get event number from site parameter file"
|
---|
22 | S NUM=$$NUM^RCMSNUM(SITE,NUM)
|
---|
23 | S:NUM>0 $P(^RC(342,1,0),"^",6)=$P(NUM,"-",2)
|
---|
24 | L -^RC(342,"RCMSNUM")
|
---|
25 | Q NUM
|
---|
26 | ;
|
---|
27 | ;
|
---|
28 | NUM(RCSITE,RCLASNUM) ; get next bill number
|
---|
29 | ; pass the site number in rcsite
|
---|
30 | ; pass the last bill number used in rclasnum
|
---|
31 | ;
|
---|
32 | ; returns the site-next bill number
|
---|
33 | ; ex 460-K100001
|
---|
34 | ;
|
---|
35 | ; make sure the site number exists
|
---|
36 | I $G(RCSITE)="" N RCSITE S RCSITE=$$SITE^RCMSITE
|
---|
37 | ;
|
---|
38 | ; make sure an initial number is sent to the common numbering series
|
---|
39 | I $G(RCLASNUM)="" Q "-1^Initial AR Common Numbering Series not supplied to driver"
|
---|
40 | ;
|
---|
41 | N RCDIGIT3,RCDIGIT4,RCDIGIT5,RCDIGIT6,RCDIGIT7,RCNEXNUM
|
---|
42 | ;
|
---|
43 | ; breakout the last 5 digits of the bill number into its ascii number
|
---|
44 | S RCDIGIT3=$A($E(RCLASNUM,3))
|
---|
45 | S RCDIGIT4=$A($E(RCLASNUM,4))
|
---|
46 | S RCDIGIT5=$A($E(RCLASNUM,5))
|
---|
47 | S RCDIGIT6=$A($E(RCLASNUM,6))
|
---|
48 | S RCDIGIT7=$A($E(RCLASNUM,7))
|
---|
49 | ;
|
---|
50 | ; add 1 to the 5 digits until you find the next bill number not
|
---|
51 | ; assigned, or if you hit the limit for the common numbering series
|
---|
52 | F D Q:RCNEXNUM
|
---|
53 | . ;
|
---|
54 | . ; increment the number by 1
|
---|
55 | . S RCDIGIT7=$$ADDONE(RCDIGIT7)
|
---|
56 | . ;
|
---|
57 | . ; if the last digit is greater than a z (ascii 90)
|
---|
58 | . ; then increment digit 6 by 1 and set the last digit to a zero
|
---|
59 | . I RCDIGIT7>90 S RCDIGIT6=$$ADDONE(RCDIGIT6),RCDIGIT7=48
|
---|
60 | . ;
|
---|
61 | . ; if the 6th digit is greater than a z
|
---|
62 | . ; then increment digit 5 by 1 and set the 6th digit to a zero
|
---|
63 | . I RCDIGIT6>90 S RCDIGIT5=$$ADDONE(RCDIGIT5),RCDIGIT6=48
|
---|
64 | . ;
|
---|
65 | . ; if the 5th digit is greater than a z
|
---|
66 | . ; then increment digit 4 by 1 and set the 5th digit to a zero
|
---|
67 | . I RCDIGIT5>90 S RCDIGIT4=$$ADDONE(RCDIGIT4),RCDIGIT5=48
|
---|
68 | . ;
|
---|
69 | . ; if the 4th digit is greater than a z
|
---|
70 | . ; then increment digit 3 by 1 and set the 4th digit to a zero
|
---|
71 | . I RCDIGIT4>90 S RCDIGIT3=$$ADDONE(RCDIGIT3),RCDIGIT4=48
|
---|
72 | . ;
|
---|
73 | . ; if the 3rd digit is greater than a z
|
---|
74 | . ; then the common numbering series is full
|
---|
75 | . I RCDIGIT3>90 S RCNEXNUM="-1^AR Common Numbering Series is Full" Q
|
---|
76 | . ;
|
---|
77 | . ; assemble the next bill number
|
---|
78 | . S RCNEXNUM=RCSITE_"-"_$E(RCLASNUM,1,2)_$C(RCDIGIT3)_$C(RCDIGIT4)_$C(RCDIGIT5)_$C(RCDIGIT6)_$C(RCDIGIT7)
|
---|
79 | . ;
|
---|
80 | . ; if there is a bill already assigned this number
|
---|
81 | . ; then stay in the loop and increment the counter again
|
---|
82 | . I $D(^PRCA(430,"B",RCNEXNUM)) S RCNEXNUM=0
|
---|
83 | ;
|
---|
84 | Q RCNEXNUM
|
---|
85 | ;
|
---|
86 | ;
|
---|
87 | ADDONE(DIGIT) ; increment the digit
|
---|
88 | S DIGIT=DIGIT+1
|
---|
89 | ; skip the ascii values 58 to 64 (punctuation characters)
|
---|
90 | ; go from ascii 57 (number 9) to ascii 65 (letter A)
|
---|
91 | I DIGIT=58 S DIGIT=65
|
---|
92 | ; do not allow the digit to be the letter o (ascii 79)
|
---|
93 | ; if it is, increment it to the letter p (ascii 80)
|
---|
94 | I DIGIT=79 S DIGIT=80
|
---|
95 | Q DIGIT
|
---|
96 | ;
|
---|
97 | ;
|
---|
98 | OLDNUM(SITE,NUM) ;Get next number
|
---|
99 | NEW X,Y,FLG
|
---|
100 | I NUM="" S X="-1^No number sent to common numbering series driver" G Q
|
---|
101 | S:$G(SITE)="" SITE=$$SITE^RCMSITE
|
---|
102 | BEG F Y=3:1:7 S X(Y)=$S($E(NUM,Y)]"":$A($E(NUM,Y)),1:48)
|
---|
103 | F Y=7:-1:3 D Q:FLG
|
---|
104 | .I Y=3,X(Y)=$A("9") S X(Y)=$A("A") S FLG=1 Q
|
---|
105 | .I X(Y)=$A("9"),X(Y-1)=$A("Z") S X(Y)=$A("A") S FLG=1 Q
|
---|
106 | .I X(Y)=$A("N") S X(Y)=$A("P") S FLG=1 Q
|
---|
107 | .I X(Y)=$A("9") S X(Y)=$A("0") S FLG=0 Q
|
---|
108 | .I Y=7,X(7)=$A("Z") S FLG=2 Q
|
---|
109 | .S X(Y)=X(Y)+1 S FLG=1
|
---|
110 | .Q
|
---|
111 | I FLG=1 D I $D(^PRCA(430,"B",SITE_"-"_NUM)) G BEG
|
---|
112 | .S NUM=$E(NUM,1,2) F Y=3:1:7 S NUM=NUM_$C(X(Y))
|
---|
113 | .Q
|
---|
114 | I FLG=2 S NUM="-1^Common Numbering series is 'full'"
|
---|
115 | S:+NUM'=-1 NUM=SITE_"-"_NUM
|
---|
116 | Q Q NUM
|
---|