source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/VSITVID.m@ 1528

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1VSITVID ;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 ;
11GETVID() ;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 ;
27NEXT(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)
33NEXTDIG 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 ;
38TEST ;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"
42TESTNEXT 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 ;
49FIXVID(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 ;
Note: See TracBrowser for help on using the repository browser.