| [613] | 1 | VSITVID ;ISL/dee - Computes the Visit Id ;4/17/97
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
|
|---|
| 3 | ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
|
|---|
| 4 | ; the incorporation of the module into PCE. For historical reference,
|
|---|
| 5 | ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
|
|---|
| 6 | ; patches.
|
|---|
| 7 | ;
|
|---|
| 8 | ;;2.0;VISIT TRACKING**2**;;Aug 12, 1996
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | GETVID() ;Sets the VSIT("VID") node with the next unique Visit Id
|
|---|
| 12 | N LASTONE,LASTSEQ,SITE,LASTUSED,NEXTSEQ
|
|---|
| 13 | ;Lock parameters file
|
|---|
| 14 | L +^DIC(150.9,1,4):1800 E Q -1
|
|---|
| 15 | ;Get the last one from parameters file
|
|---|
| 16 | S LASTONE=^DIC(150.9,1,4)
|
|---|
| 17 | S LASTSEQ=$P(LASTONE,"^",1)
|
|---|
| 18 | S SITE=$P(^VSIT(150.2,$P(LASTONE,"^",2),0),"^",2)
|
|---|
| 19 | ;Get the next one (call the function below)
|
|---|
| 20 | S NEXTSEQ=$$NEXT(LASTSEQ)
|
|---|
| 21 | ;Save new one in parameters file
|
|---|
| 22 | S $P(^DIC(150.9,1,4),"^",1)=NEXTSEQ
|
|---|
| 23 | L -^DIC(150.9,1,4)
|
|---|
| 24 | ;Combine the sequence number and the site to make the new Visit Id
|
|---|
| 25 | Q NEXTSEQ_"-"_SITE
|
|---|
| 26 | ;
|
|---|
| 27 | NEXT(SEQNUMB) ;Pass in the last sequence number and returns the next unique number in the sequence
|
|---|
| 28 | ;This routine adds one to a base 27 number
|
|---|
| 29 | N VSITSTR,VSITPLAC,VSITDIG
|
|---|
| 30 | ;Do not change this string (or the copy of it below in FIXVID):
|
|---|
| 31 | S VSITSTR="0123456789BCDFGHJKMNPQRTVWX0"
|
|---|
| 32 | S VSITPLAC=$L(SEQNUMB)
|
|---|
| 33 | NEXTDIG S VSITDIG=$E(VSITSTR,$F(VSITSTR,$E(SEQNUMB,VSITPLAC)))
|
|---|
| 34 | S SEQNUMB=$E(SEQNUMB,0,VSITPLAC-1)_VSITDIG_$E(SEQNUMB,VSITPLAC+1,99)
|
|---|
| 35 | I VSITDIG=0 S VSITPLAC=VSITPLAC-1 S:VSITPLAC<1 SEQNUMB="0"_SEQNUMB,VSITPLAC=1 G NEXTDIG
|
|---|
| 36 | Q SEQNUMB
|
|---|
| 37 | ;
|
|---|
| 38 | TEST ;This prints every 100,000 number in base 27 then base 10
|
|---|
| 39 | W !,"WARNING, This routine never quits!"
|
|---|
| 40 | S COUNT=0
|
|---|
| 41 | S NUM="0"
|
|---|
| 42 | TESTNEXT S NUM=$$NEXT(NUM)
|
|---|
| 43 | S COUNT=COUNT+1
|
|---|
| 44 | I '(COUNT#100000) W !,NUM," ",COUNT Q
|
|---|
| 45 | G TESTNEXT
|
|---|
| 46 | K COUNT,NUM
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | FIXVID(VSITIEN) ;If the Visit ID is not valued then get a new id and store it
|
|---|
| 50 | ;Return:
|
|---|
| 51 | ; -2 If called with a bad pointer to Visit
|
|---|
| 52 | ; -1 If could not get a new Visit ID or store it.
|
|---|
| 53 | ; Visit ID If Visit has one or one was added.
|
|---|
| 54 | N VSITVID,VSITTEST
|
|---|
| 55 | Q:$G(VSITIEN)<1 -2
|
|---|
| 56 | Q:'($D(^AUPNVSIT(VSITIEN,0))#2) -2
|
|---|
| 57 | ;Test to see if current Visit ID is good.
|
|---|
| 58 | S VSITVID=$P($G(^AUPNVSIT(VSITIEN,150)),"^",1)
|
|---|
| 59 | ; check against the DD for the field
|
|---|
| 60 | D CHK^DIE(9000010,15001,"",VSITVID,.VSITTEST)
|
|---|
| 61 | ; it is bad if VSITTEST="^"
|
|---|
| 62 | I VSITTEST'="^" D Q:VSITTEST'="^" VSITVID
|
|---|
| 63 | . ;Fileman said it was good now make sure value is valid
|
|---|
| 64 | . ;Do not change this string (it is the same as the one above):
|
|---|
| 65 | . I $TR($P(VSITVID,"-",1),"0123456789BCDFGHJKMNPQRTVWX0")'="" S VSITTEST="^"
|
|---|
| 66 | . E I '$D(^VSIT(150.2,"D",$P(VSITVID,"-",2))) S VSITTEST="^"
|
|---|
| 67 | ;
|
|---|
| 68 | ;Need to get new Visit Id
|
|---|
| 69 | N VSIT
|
|---|
| 70 | S VSIT("VID")=$$GETVID ; Get new Visit ID
|
|---|
| 71 | Q:VSIT("VID")=-1 -1 ; Return -1 if can not get a Visit ID
|
|---|
| 72 | I VSITVID]"" D ; Delete bad Visit ID if there is one
|
|---|
| 73 | . S $P(^AUPNVSIT(VSITIEN,150),"^",1)=""
|
|---|
| 74 | . K ^AUPNVSIT("VID",VSITVID,VSITIEN)
|
|---|
| 75 | S VSIT("IEN")=VSITIEN
|
|---|
| 76 | D UPD^VSIT ; Save new Visit ID
|
|---|
| 77 | I VSIT("VID")=$P($G(^AUPNVSIT(VSITIEN,150)),"^",1) Q VSIT("VID")
|
|---|
| 78 | Q -1
|
|---|
| 79 | ;
|
|---|
