VSITVID ;ISL/dee - Computes the Visit Id ;4/17/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
; the incorporation of the module into PCE. For historical reference,
; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
; patches.
;
;;2.0;VISIT TRACKING**2**;;Aug 12, 1996
Q
;
GETVID() ;Sets the VSIT("VID") node with the next unique Visit Id
N LASTONE,LASTSEQ,SITE,LASTUSED,NEXTSEQ
;Lock parameters file
L +^DIC(150.9,1,4):1800 E Q -1
;Get the last one from parameters file
S LASTONE=^DIC(150.9,1,4)
S LASTSEQ=$P(LASTONE,"^",1)
S SITE=$P(^VSIT(150.2,$P(LASTONE,"^",2),0),"^",2)
;Get the next one (call the function below)
S NEXTSEQ=$$NEXT(LASTSEQ)
;Save new one in parameters file
S $P(^DIC(150.9,1,4),"^",1)=NEXTSEQ
L -^DIC(150.9,1,4)
;Combine the sequence number and the site to make the new Visit Id
Q NEXTSEQ_"-"_SITE
;
NEXT(SEQNUMB) ;Pass in the last sequence number and returns the next unique number in the sequence
;This routine adds one to a base 27 number
N VSITSTR,VSITPLAC,VSITDIG
;Do not change this string (or the copy of it below in FIXVID):
S VSITSTR="0123456789BCDFGHJKMNPQRTVWX0"
S VSITPLAC=$L(SEQNUMB)
NEXTDIG S VSITDIG=$E(VSITSTR,$F(VSITSTR,$E(SEQNUMB,VSITPLAC)))
S SEQNUMB=$E(SEQNUMB,0,VSITPLAC-1)_VSITDIG_$E(SEQNUMB,VSITPLAC+1,99)
I VSITDIG=0 S VSITPLAC=VSITPLAC-1 S:VSITPLAC<1 SEQNUMB="0"_SEQNUMB,VSITPLAC=1 G NEXTDIG
Q SEQNUMB
;
TEST ;This prints every 100,000 number in base 27 then base 10
W !,"WARNING, This routine never quits!"
S COUNT=0
S NUM="0"
TESTNEXT S NUM=$$NEXT(NUM)
S COUNT=COUNT+1
I '(COUNT#100000) W !,NUM," ",COUNT Q
G TESTNEXT
K COUNT,NUM
Q
;
FIXVID(VSITIEN) ;If the Visit ID is not valued then get a new id and store it
;Return:
; -2 If called with a bad pointer to Visit
; -1 If could not get a new Visit ID or store it.
; Visit ID If Visit has one or one was added.
N VSITVID,VSITTEST
Q:$G(VSITIEN)<1 -2
Q:'($D(^AUPNVSIT(VSITIEN,0))#2) -2
;Test to see if current Visit ID is good.
S VSITVID=$P($G(^AUPNVSIT(VSITIEN,150)),"^",1)
; check against the DD for the field
D CHK^DIE(9000010,15001,"",VSITVID,.VSITTEST)
; it is bad if VSITTEST="^"
I VSITTEST'="^" D Q:VSITTEST'="^" VSITVID
. ;Fileman said it was good now make sure value is valid
. ;Do not change this string (it is the same as the one above):
. I $TR($P(VSITVID,"-",1),"0123456789BCDFGHJKMNPQRTVWX0")'="" S VSITTEST="^"
. E I '$D(^VSIT(150.2,"D",$P(VSITVID,"-",2))) S VSITTEST="^"
;
;Need to get new Visit Id
N VSIT
S VSIT("VID")=$$GETVID ; Get new Visit ID
Q:VSIT("VID")=-1 -1 ; Return -1 if can not get a Visit ID
I VSITVID]"" D ; Delete bad Visit ID if there is one
. S $P(^AUPNVSIT(VSITIEN,150),"^",1)=""
. K ^AUPNVSIT("VID",VSITVID,VSITIEN)
S VSIT("IEN")=VSITIEN
D UPD^VSIT ; Save new Visit ID
I VSIT("VID")=$P($G(^AUPNVSIT(VSITIEN,150)),"^",1) Q VSIT("VID")
Q -1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITVID 3115 printed Apr 09, 2024@21:34:25 Page 2
VSITVID ;ISL/dee - Computes the Visit Id ;4/17/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
+2 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
+3 ; the incorporation of the module into PCE. For historical reference,
+4 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
+5 ; patches.
+6 ;
+7 ;;2.0;VISIT TRACKING**2**;;Aug 12, 1996
+8 QUIT
+9 ;
GETVID() ;Sets the VSIT("VID") node with the next unique Visit Id
+1 NEW LASTONE,LASTSEQ,SITE,LASTUSED,NEXTSEQ
+2 ;Lock parameters file
+3 LOCK +^DIC(150.9,1,4):1800
IF '$TEST
QUIT -1
+4 ;Get the last one from parameters file
+5 SET LASTONE=^DIC(150.9,1,4)
+6 SET LASTSEQ=$PIECE(LASTONE,"^",1)
+7 SET SITE=$PIECE(^VSIT(150.2,$PIECE(LASTONE,"^",2),0),"^",2)
+8 ;Get the next one (call the function below)
+9 SET NEXTSEQ=$$NEXT(LASTSEQ)
+10 ;Save new one in parameters file
+11 SET $PIECE(^DIC(150.9,1,4),"^",1)=NEXTSEQ
+12 LOCK -^DIC(150.9,1,4)
+13 ;Combine the sequence number and the site to make the new Visit Id
+14 QUIT NEXTSEQ_"-"_SITE
+15 ;
NEXT(SEQNUMB) ;Pass in the last sequence number and returns the next unique number in the sequence
+1 ;This routine adds one to a base 27 number
+2 NEW VSITSTR,VSITPLAC,VSITDIG
+3 ;Do not change this string (or the copy of it below in FIXVID):
+4 SET VSITSTR="0123456789BCDFGHJKMNPQRTVWX0"
+5 SET VSITPLAC=$LENGTH(SEQNUMB)
NEXTDIG SET VSITDIG=$EXTRACT(VSITSTR,$FIND(VSITSTR,$EXTRACT(SEQNUMB,VSITPLAC)))
+1 SET SEQNUMB=$EXTRACT(SEQNUMB,0,VSITPLAC-1)_VSITDIG_$EXTRACT(SEQNUMB,VSITPLAC+1,99)
+2 IF VSITDIG=0
SET VSITPLAC=VSITPLAC-1
if VSITPLAC<1
SET SEQNUMB="0"_SEQNUMB
SET VSITPLAC=1
GOTO NEXTDIG
+3 QUIT SEQNUMB
+4 ;
TEST ;This prints every 100,000 number in base 27 then base 10
+1 WRITE !,"WARNING, This routine never quits!"
+2 SET COUNT=0
+3 SET NUM="0"
TESTNEXT SET NUM=$$NEXT(NUM)
+1 SET COUNT=COUNT+1
+2 IF '(COUNT#100000)
WRITE !,NUM," ",COUNT
QUIT
+3 GOTO TESTNEXT
+4 KILL COUNT,NUM
+5 QUIT
+6 ;
FIXVID(VSITIEN) ;If the Visit ID is not valued then get a new id and store it
+1 ;Return:
+2 ; -2 If called with a bad pointer to Visit
+3 ; -1 If could not get a new Visit ID or store it.
+4 ; Visit ID If Visit has one or one was added.
+5 NEW VSITVID,VSITTEST
+6 if $GET(VSITIEN)<1
QUIT -2
+7 if '($DATA(^AUPNVSIT(VSITIEN,0))#2)
QUIT -2
+8 ;Test to see if current Visit ID is good.
+9 SET VSITVID=$PIECE($GET(^AUPNVSIT(VSITIEN,150)),"^",1)
+10 ; check against the DD for the field
+11 DO CHK^DIE(9000010,15001,"",VSITVID,.VSITTEST)
+12 ; it is bad if VSITTEST="^"
+13 IF VSITTEST'="^"
Begin DoDot:1
+14 ;Fileman said it was good now make sure value is valid
+15 ;Do not change this string (it is the same as the one above):
+16 IF $TRANSLATE($PIECE(VSITVID,"-",1),"0123456789BCDFGHJKMNPQRTVWX0")'=""
SET VSITTEST="^"
+17 IF '$TEST
IF '$DATA(^VSIT(150.2,"D",$PIECE(VSITVID,"-",2)))
SET VSITTEST="^"
End DoDot:1
if VSITTEST'="^"
QUIT VSITVID
+18 ;
+19 ;Need to get new Visit Id
+20 NEW VSIT
+21 ; Get new Visit ID
SET VSIT("VID")=$$GETVID
+22 ; Return -1 if can not get a Visit ID
if VSIT("VID")=-1
QUIT -1
+23 ; Delete bad Visit ID if there is one
IF VSITVID]""
Begin DoDot:1
+24 SET $PIECE(^AUPNVSIT(VSITIEN,150),"^",1)=""
+25 KILL ^AUPNVSIT("VID",VSITVID,VSITIEN)
End DoDot:1
+26 SET VSIT("IEN")=VSITIEN
+27 ; Save new Visit ID
DO UPD^VSIT
+28 IF VSIT("VID")=$PIECE($GET(^AUPNVSIT(VSITIEN,150)),"^",1)
QUIT VSIT("VID")
+29 QUIT -1
+30 ;
