DICLIB ;SFISC/TKW - LIBRARY OF FUNCTIONS FOR ^DIC ;05:00 PM 14 Oct 1998
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
NXTNO(F,DA,FLAGS) ;GET NEXT RECORD NUMBER FOR FILE OR SUBFILE F (F CAN CONTAIN A GLOBAL REFERENCE TO IMPROVE EFFICIENCY)
;DA=DA ARRAY (IF F IS A SUBFILE)
;FLAGS (OPTIONAL) IF IT CONTAINS "U", WILL UPDATE LAST REC.# ON 0 NODE
N I,X,Y,DIC,% S X=0,I=1
S:'F DIC=$TR(F,")",",") S:F DIC=$$ROOT^DIQGU(F,.DA)
G:DIC="" QI G:'$D(@(DIC_"0)")) QI
INCR L @("+"_DIC_"0):10") G:'$T QL
I 'X S Y=@(DIC_"0)"),X=$P($P(Y,U,3),"."),%=+$P(Y,U,2) I '$D(^DIA(%,"B")) S %=0
F I=1:1 S X=X+1 Q:'$D(@(DIC_X_")"))&$S(%:+$O(^DIA(%,"B",X_","))'=X&'$D(^(X)),1:1) I I=100 S I=0 Q
I 'I L @("-"_DIC_"0)") G INCR
I $G(FLAGS)["U" S $P(@(DIC_"0)"),U,3,4)=X_U_($P(Y,U,4)+1)
L @("-"_DIC_"0)")
Q X
QI D BLD^DIALOG(200) G Q0
QL D BLD^DIALOG(110,F)
Q0 Q 0
;DIALOG #200 'An input variable or parameter is missing or invalid.'
; #110 'The record is currently locked'
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICLIB 1246 printed Dec 13, 2024@02:46:13 Page 2
DICLIB ;SFISC/TKW - LIBRARY OF FUNCTIONS FOR ^DIC ;05:00 PM 14 Oct 1998
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
NXTNO(F,DA,FLAGS) ;GET NEXT RECORD NUMBER FOR FILE OR SUBFILE F (F CAN CONTAIN A GLOBAL REFERENCE TO IMPROVE EFFICIENCY)
+1 ;DA=DA ARRAY (IF F IS A SUBFILE)
+2 ;FLAGS (OPTIONAL) IF IT CONTAINS "U", WILL UPDATE LAST REC.# ON 0 NODE
+3 NEW I,X,Y,DIC,%
SET X=0
SET I=1
+4 if 'F
SET DIC=$TRANSLATE(F,")",",")
if F
SET DIC=$$ROOT^DIQGU(F,.DA)
+5 if DIC=""
GOTO QI
if '$DATA(@(DIC_"0)"))
GOTO QI
INCR LOCK @("+"_DIC_"0):10")
if '$TEST
GOTO QL
+1 IF 'X
SET Y=@(DIC_"0)")
SET X=$PIECE($PIECE(Y,U,3),".")
SET %=+$PIECE(Y,U,2)
IF '$DATA(^DIA(%,"B"))
SET %=0
+2 FOR I=1:1
SET X=X+1
if '$DATA(@(DIC_X_")"))&$SELECT(%
QUIT
IF I=100
SET I=0
QUIT
+3 IF 'I
LOCK @("-"_DIC_"0)")
GOTO INCR
+4 IF $GET(FLAGS)["U"
SET $PIECE(@(DIC_"0)"),U,3,4)=X_U_($PIECE(Y,U,4)+1)
+5 LOCK @("-"_DIC_"0)")
+6 QUIT X
QI DO BLD^DIALOG(200)
GOTO Q0
QL DO BLD^DIALOG(110,F)
Q0 QUIT 0
+1 ;DIALOG #200 'An input variable or parameter is missing or invalid.'
+2 ; #110 'The record is currently locked'
