- 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 Mar 13, 2025@21:50:57 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'
