RCMSNUM ;WASH-ISC@ALTOONA,PA/RGY-Assign Common Numbering Series ;1/11/96 11:40 AM
V ;;4.5;Accounts Receivable;**27,114,172**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
BNUM(SITE) ;Get next bill number
NEW NUM
L +^RC(342,"RCMSNUM"):15 I '$T Q "-1^Common Numbering series driver is busy"
S NUM=$P($G(^RC(342,1,0)),"^",3),SITE=$G(SITE)
I NUM="" D BNUM^PRCABJ S NUM=$P($G(^RC(342,1,0)),"^",3)
I NUM="" L -^RC(342,"RCMSNUM") Q "-1^Cannot get bill number from site parameter file"
S NUM=$$NUM^RCMSNUM(SITE,NUM)
S:NUM>0 $P(^RC(342,1,0),"^",3)=$P(NUM,"-",2)
L -^RC(342,"RCMSNUM")
Q NUM
;
;
ENUM(SITE) ;Get next event number
NEW NUM
L +^RC(342,"RCMSNUM"):15 I '$T Q "-1^Common Numbering series driver is busy"
S NUM=$P($G(^RC(342,1,0)),"^",6),SITE=$G(SITE)
I NUM="" D ENUM^PRCABJ S NUM=$P($G(^RC(342,1,0)),"^",6)
I NUM="" L -^RC(342,"RCMSNUM") Q "-1^Cannot get event number from site parameter file"
S NUM=$$NUM^RCMSNUM(SITE,NUM)
S:NUM>0 $P(^RC(342,1,0),"^",6)=$P(NUM,"-",2)
L -^RC(342,"RCMSNUM")
Q NUM
;
;
NUM(RCSITE,RCLASNUM) ; get next bill number
; pass the site number in rcsite
; pass the last bill number used in rclasnum
;
; returns the site-next bill number
; ex 460-K100001
;
; make sure the site number exists
I $G(RCSITE)="" N RCSITE S RCSITE=$$SITE^RCMSITE
;
; make sure an initial number is sent to the common numbering series
I $G(RCLASNUM)="" Q "-1^Initial AR Common Numbering Series not supplied to driver"
;
N RCDIGIT3,RCDIGIT4,RCDIGIT5,RCDIGIT6,RCDIGIT7,RCNEXNUM
;
; breakout the last 5 digits of the bill number into its ascii number
S RCDIGIT3=$A($E(RCLASNUM,3))
S RCDIGIT4=$A($E(RCLASNUM,4))
S RCDIGIT5=$A($E(RCLASNUM,5))
S RCDIGIT6=$A($E(RCLASNUM,6))
S RCDIGIT7=$A($E(RCLASNUM,7))
;
; add 1 to the 5 digits until you find the next bill number not
; assigned, or if you hit the limit for the common numbering series
F D Q:RCNEXNUM
. ;
. ; increment the number by 1
. S RCDIGIT7=$$ADDONE(RCDIGIT7)
. ;
. ; if the last digit is greater than a z (ascii 90)
. ; then increment digit 6 by 1 and set the last digit to a zero
. I RCDIGIT7>90 S RCDIGIT6=$$ADDONE(RCDIGIT6),RCDIGIT7=48
. ;
. ; if the 6th digit is greater than a z
. ; then increment digit 5 by 1 and set the 6th digit to a zero
. I RCDIGIT6>90 S RCDIGIT5=$$ADDONE(RCDIGIT5),RCDIGIT6=48
. ;
. ; if the 5th digit is greater than a z
. ; then increment digit 4 by 1 and set the 5th digit to a zero
. I RCDIGIT5>90 S RCDIGIT4=$$ADDONE(RCDIGIT4),RCDIGIT5=48
. ;
. ; if the 4th digit is greater than a z
. ; then increment digit 3 by 1 and set the 4th digit to a zero
. I RCDIGIT4>90 S RCDIGIT3=$$ADDONE(RCDIGIT3),RCDIGIT4=48
. ;
. ; if the 3rd digit is greater than a z
. ; then the common numbering series is full
. I RCDIGIT3>90 S RCNEXNUM="-1^AR Common Numbering Series is Full" Q
. ;
. ; assemble the next bill number
. S RCNEXNUM=RCSITE_"-"_$E(RCLASNUM,1,2)_$C(RCDIGIT3)_$C(RCDIGIT4)_$C(RCDIGIT5)_$C(RCDIGIT6)_$C(RCDIGIT7)
. ;
. ; if there is a bill already assigned this number
. ; then stay in the loop and increment the counter again
. I $D(^PRCA(430,"B",RCNEXNUM)) S RCNEXNUM=0
;
Q RCNEXNUM
;
;
ADDONE(DIGIT) ; increment the digit
S DIGIT=DIGIT+1
; skip the ascii values 58 to 64 (punctuation characters)
; go from ascii 57 (number 9) to ascii 65 (letter A)
I DIGIT=58 S DIGIT=65
; do not allow the digit to be the letter o (ascii 79)
; if it is, increment it to the letter p (ascii 80)
I DIGIT=79 S DIGIT=80
Q DIGIT
;
;
OLDNUM(SITE,NUM) ;Get next number
NEW X,Y,FLG
I NUM="" S X="-1^No number sent to common numbering series driver" G Q
S:$G(SITE)="" SITE=$$SITE^RCMSITE
BEG F Y=3:1:7 S X(Y)=$S($E(NUM,Y)]"":$A($E(NUM,Y)),1:48)
F Y=7:-1:3 D Q:FLG
.I Y=3,X(Y)=$A("9") S X(Y)=$A("A") S FLG=1 Q
.I X(Y)=$A("9"),X(Y-1)=$A("Z") S X(Y)=$A("A") S FLG=1 Q
.I X(Y)=$A("N") S X(Y)=$A("P") S FLG=1 Q
.I X(Y)=$A("9") S X(Y)=$A("0") S FLG=0 Q
.I Y=7,X(7)=$A("Z") S FLG=2 Q
.S X(Y)=X(Y)+1 S FLG=1
.Q
I FLG=1 D I $D(^PRCA(430,"B",SITE_"-"_NUM)) G BEG
.S NUM=$E(NUM,1,2) F Y=3:1:7 S NUM=NUM_$C(X(Y))
.Q
I FLG=2 S NUM="-1^Common Numbering series is 'full'"
S:+NUM'=-1 NUM=SITE_"-"_NUM
Q Q NUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCMSNUM 4435 printed Dec 13, 2024@01:47:13 Page 2
RCMSNUM ;WASH-ISC@ALTOONA,PA/RGY-Assign Common Numbering Series ;1/11/96 11:40 AM
V ;;4.5;Accounts Receivable;**27,114,172**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
BNUM(SITE) ;Get next bill number
+1 NEW NUM
+2 LOCK +^RC(342,"RCMSNUM"):15
IF '$TEST
QUIT "-1^Common Numbering series driver is busy"
+3 SET NUM=$PIECE($GET(^RC(342,1,0)),"^",3)
SET SITE=$GET(SITE)
+4 IF NUM=""
DO BNUM^PRCABJ
SET NUM=$PIECE($GET(^RC(342,1,0)),"^",3)
+5 IF NUM=""
LOCK -^RC(342,"RCMSNUM")
QUIT "-1^Cannot get bill number from site parameter file"
+6 SET NUM=$$NUM^RCMSNUM(SITE,NUM)
+7 if NUM>0
SET $PIECE(^RC(342,1,0),"^",3)=$PIECE(NUM,"-",2)
+8 LOCK -^RC(342,"RCMSNUM")
+9 QUIT NUM
+10 ;
+11 ;
ENUM(SITE) ;Get next event number
+1 NEW NUM
+2 LOCK +^RC(342,"RCMSNUM"):15
IF '$TEST
QUIT "-1^Common Numbering series driver is busy"
+3 SET NUM=$PIECE($GET(^RC(342,1,0)),"^",6)
SET SITE=$GET(SITE)
+4 IF NUM=""
DO ENUM^PRCABJ
SET NUM=$PIECE($GET(^RC(342,1,0)),"^",6)
+5 IF NUM=""
LOCK -^RC(342,"RCMSNUM")
QUIT "-1^Cannot get event number from site parameter file"
+6 SET NUM=$$NUM^RCMSNUM(SITE,NUM)
+7 if NUM>0
SET $PIECE(^RC(342,1,0),"^",6)=$PIECE(NUM,"-",2)
+8 LOCK -^RC(342,"RCMSNUM")
+9 QUIT NUM
+10 ;
+11 ;
NUM(RCSITE,RCLASNUM) ; get next bill number
+1 ; pass the site number in rcsite
+2 ; pass the last bill number used in rclasnum
+3 ;
+4 ; returns the site-next bill number
+5 ; ex 460-K100001
+6 ;
+7 ; make sure the site number exists
+8 IF $GET(RCSITE)=""
NEW RCSITE
SET RCSITE=$$SITE^RCMSITE
+9 ;
+10 ; make sure an initial number is sent to the common numbering series
+11 IF $GET(RCLASNUM)=""
QUIT "-1^Initial AR Common Numbering Series not supplied to driver"
+12 ;
+13 NEW RCDIGIT3,RCDIGIT4,RCDIGIT5,RCDIGIT6,RCDIGIT7,RCNEXNUM
+14 ;
+15 ; breakout the last 5 digits of the bill number into its ascii number
+16 SET RCDIGIT3=$ASCII($EXTRACT(RCLASNUM,3))
+17 SET RCDIGIT4=$ASCII($EXTRACT(RCLASNUM,4))
+18 SET RCDIGIT5=$ASCII($EXTRACT(RCLASNUM,5))
+19 SET RCDIGIT6=$ASCII($EXTRACT(RCLASNUM,6))
+20 SET RCDIGIT7=$ASCII($EXTRACT(RCLASNUM,7))
+21 ;
+22 ; add 1 to the 5 digits until you find the next bill number not
+23 ; assigned, or if you hit the limit for the common numbering series
+24 FOR
Begin DoDot:1
+25 ;
+26 ; increment the number by 1
+27 SET RCDIGIT7=$$ADDONE(RCDIGIT7)
+28 ;
+29 ; if the last digit is greater than a z (ascii 90)
+30 ; then increment digit 6 by 1 and set the last digit to a zero
+31 IF RCDIGIT7>90
SET RCDIGIT6=$$ADDONE(RCDIGIT6)
SET RCDIGIT7=48
+32 ;
+33 ; if the 6th digit is greater than a z
+34 ; then increment digit 5 by 1 and set the 6th digit to a zero
+35 IF RCDIGIT6>90
SET RCDIGIT5=$$ADDONE(RCDIGIT5)
SET RCDIGIT6=48
+36 ;
+37 ; if the 5th digit is greater than a z
+38 ; then increment digit 4 by 1 and set the 5th digit to a zero
+39 IF RCDIGIT5>90
SET RCDIGIT4=$$ADDONE(RCDIGIT4)
SET RCDIGIT5=48
+40 ;
+41 ; if the 4th digit is greater than a z
+42 ; then increment digit 3 by 1 and set the 4th digit to a zero
+43 IF RCDIGIT4>90
SET RCDIGIT3=$$ADDONE(RCDIGIT3)
SET RCDIGIT4=48
+44 ;
+45 ; if the 3rd digit is greater than a z
+46 ; then the common numbering series is full
+47 IF RCDIGIT3>90
SET RCNEXNUM="-1^AR Common Numbering Series is Full"
QUIT
+48 ;
+49 ; assemble the next bill number
+50 SET RCNEXNUM=RCSITE_"-"_$EXTRACT(RCLASNUM,1,2)_$CHAR(RCDIGIT3)_$CHAR(RCDIGIT4)_$CHAR(RCDIGIT5)_$CHAR(RCDIGIT6)_$CHAR(RCDIGIT7)
+51 ;
+52 ; if there is a bill already assigned this number
+53 ; then stay in the loop and increment the counter again
+54 IF $DATA(^PRCA(430,"B",RCNEXNUM))
SET RCNEXNUM=0
End DoDot:1
if RCNEXNUM
QUIT
+55 ;
+56 QUIT RCNEXNUM
+57 ;
+58 ;
ADDONE(DIGIT) ; increment the digit
+1 SET DIGIT=DIGIT+1
+2 ; skip the ascii values 58 to 64 (punctuation characters)
+3 ; go from ascii 57 (number 9) to ascii 65 (letter A)
+4 IF DIGIT=58
SET DIGIT=65
+5 ; do not allow the digit to be the letter o (ascii 79)
+6 ; if it is, increment it to the letter p (ascii 80)
+7 IF DIGIT=79
SET DIGIT=80
+8 QUIT DIGIT
+9 ;
+10 ;
OLDNUM(SITE,NUM) ;Get next number
+1 NEW X,Y,FLG
+2 IF NUM=""
SET X="-1^No number sent to common numbering series driver"
GOTO Q
+3 if $GET(SITE)=""
SET SITE=$$SITE^RCMSITE
BEG FOR Y=3:1:7
SET X(Y)=$SELECT($EXTRACT(NUM,Y)]"":$ASCII($EXTRACT(NUM,Y)),1:48)
+1 FOR Y=7:-1:3
Begin DoDot:1
+2 IF Y=3
IF X(Y)=$ASCII("9")
SET X(Y)=$ASCII("A")
SET FLG=1
QUIT
+3 IF X(Y)=$ASCII("9")
IF X(Y-1)=$ASCII("Z")
SET X(Y)=$ASCII("A")
SET FLG=1
QUIT
+4 IF X(Y)=$ASCII("N")
SET X(Y)=$ASCII("P")
SET FLG=1
QUIT
+5 IF X(Y)=$ASCII("9")
SET X(Y)=$ASCII("0")
SET FLG=0
QUIT
+6 IF Y=7
IF X(7)=$ASCII("Z")
SET FLG=2
QUIT
+7 SET X(Y)=X(Y)+1
SET FLG=1
+8 QUIT
End DoDot:1
if FLG
QUIT
+9 IF FLG=1
Begin DoDot:1
+10 SET NUM=$EXTRACT(NUM,1,2)
FOR Y=3:1:7
SET NUM=NUM_$CHAR(X(Y))
+11 QUIT
End DoDot:1
IF $DATA(^PRCA(430,"B",SITE_"-"_NUM))
GOTO BEG
+12 IF FLG=2
SET NUM="-1^Common Numbering series is 'full'"
+13 if +NUM'=-1
SET NUM=SITE_"-"_NUM
Q QUIT NUM
