source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCMSNUM.m@ 1087

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1RCMSNUM ;WASH-ISC@ALTOONA,PA/RGY-Assign Common Numbering Series ;1/11/96 11:40 AM
2V ;;4.5;Accounts Receivable;**27,114,172**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4BNUM(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 ;
16ENUM(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 ;
28NUM(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 ;
87ADDONE(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 ;
98OLDNUM(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
102BEG 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
116Q Q NUM
Note: See TracBrowser for help on using the repository browser.