DICLIB.m

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 ---DICLIB   1246     printed  Apr 09, 2024@21:51:40                                                                                                                                                                                                      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'