Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VSITVID

VSITVID.m

Go to the documentation of this file.
  1. VSITVID ;ISL/dee - Computes the Visit Id ;4/17/97
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
  1. ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
  1. ; the incorporation of the module into PCE. For historical reference,
  1. ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
  1. ; patches.
  1. ;
  1. ;;2.0;VISIT TRACKING**2**;;Aug 12, 1996
  1. Q
  1. ;
  1. GETVID() ;Sets the VSIT("VID") node with the next unique Visit Id
  1. N LASTONE,LASTSEQ,SITE,LASTUSED,NEXTSEQ
  1. ;Lock parameters file
  1. L +^DIC(150.9,1,4):1800 E Q -1
  1. ;Get the last one from parameters file
  1. S LASTONE=^DIC(150.9,1,4)
  1. S LASTSEQ=$P(LASTONE,"^",1)
  1. S SITE=$P(^VSIT(150.2,$P(LASTONE,"^",2),0),"^",2)
  1. ;Get the next one (call the function below)
  1. S NEXTSEQ=$$NEXT(LASTSEQ)
  1. ;Save new one in parameters file
  1. S $P(^DIC(150.9,1,4),"^",1)=NEXTSEQ
  1. L -^DIC(150.9,1,4)
  1. ;Combine the sequence number and the site to make the new Visit Id
  1. Q NEXTSEQ_"-"_SITE
  1. ;
  1. 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
  1. N VSITSTR,VSITPLAC,VSITDIG
  1. ;Do not change this string (or the copy of it below in FIXVID):
  1. S VSITSTR="0123456789BCDFGHJKMNPQRTVWX0"
  1. S VSITPLAC=$L(SEQNUMB)
  1. NEXTDIG S VSITDIG=$E(VSITSTR,$F(VSITSTR,$E(SEQNUMB,VSITPLAC)))
  1. S SEQNUMB=$E(SEQNUMB,0,VSITPLAC-1)_VSITDIG_$E(SEQNUMB,VSITPLAC+1,99)
  1. I VSITDIG=0 S VSITPLAC=VSITPLAC-1 S:VSITPLAC<1 SEQNUMB="0"_SEQNUMB,VSITPLAC=1 G NEXTDIG
  1. Q SEQNUMB
  1. ;
  1. TEST ;This prints every 100,000 number in base 27 then base 10
  1. W !,"WARNING, This routine never quits!"
  1. S COUNT=0
  1. S NUM="0"
  1. TESTNEXT S NUM=$$NEXT(NUM)
  1. S COUNT=COUNT+1
  1. I '(COUNT#100000) W !,NUM," ",COUNT Q
  1. G TESTNEXT
  1. K COUNT,NUM
  1. Q
  1. ;
  1. FIXVID(VSITIEN) ;If the Visit ID is not valued then get a new id and store it
  1. ;Return:
  1. ; -2 If called with a bad pointer to Visit
  1. ; -1 If could not get a new Visit ID or store it.
  1. ; Visit ID If Visit has one or one was added.
  1. N VSITVID,VSITTEST
  1. Q:$G(VSITIEN)<1 -2
  1. Q:'($D(^AUPNVSIT(VSITIEN,0))#2) -2
  1. ;Test to see if current Visit ID is good.
  1. S VSITVID=$P($G(^AUPNVSIT(VSITIEN,150)),"^",1)
  1. ; check against the DD for the field
  1. D CHK^DIE(9000010,15001,"",VSITVID,.VSITTEST)
  1. ; it is bad if VSITTEST="^"
  1. I VSITTEST'="^" D Q:VSITTEST'="^" VSITVID
  1. . ;Fileman said it was good now make sure value is valid
  1. . ;Do not change this string (it is the same as the one above):
  1. . I $TR($P(VSITVID,"-",1),"0123456789BCDFGHJKMNPQRTVWX0")'="" S VSITTEST="^"
  1. . E I '$D(^VSIT(150.2,"D",$P(VSITVID,"-",2))) S VSITTEST="^"
  1. ;
  1. ;Need to get new Visit Id
  1. N VSIT
  1. S VSIT("VID")=$$GETVID ; Get new Visit ID
  1. Q:VSIT("VID")=-1 -1 ; Return -1 if can not get a Visit ID
  1. I VSITVID]"" D ; Delete bad Visit ID if there is one
  1. . S $P(^AUPNVSIT(VSITIEN,150),"^",1)=""
  1. . K ^AUPNVSIT("VID",VSITVID,VSITIEN)
  1. S VSIT("IEN")=VSITIEN
  1. D UPD^VSIT ; Save new Visit ID
  1. I VSIT("VID")=$P($G(^AUPNVSIT(VSITIEN,150)),"^",1) Q VSIT("VID")
  1. Q -1
  1. ;