- 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 Feb 18, 2025@23:59 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 ;