| [613] | 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
|
|---|
