DINIT42.m

DINIT42 ;SFISC/XAK-INITIALIZE VA FILEMAN ;10MAR2008

 ;;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.

 ;

 I $G(^DD("FUNC",89,0))="DUPLICATED" S DA=89,DIK="^DD(""FUNC""," D ^DIK

 S %=47

DD F I=1:5 S X=$E($T(DD+I),4,999),%=%+1 G FUNC:X?.P S ^DD("FUNC",%,0)=$P(X,";"),Y=I F DU=1,2,3,9 S Y=Y+1,X=$E($T(DD+Y),4,999) I X]"" S ^(DU)=X

 ;;PARAM

 ;;S X=$S(X=""!(X'?.ANP):"",$D(DIPA($E(X,1,30))):DIPA($E(X,1,30)),1:"")

 ;;

 ;;

 ;;RETURNS VALUE OF PARAMETER NAMED BY ARGUMENT

 ;;IOM

 ;;S X=$G(IOM,80)

 ;;

 ;;0

 ;;RETURNS THE NUMBER OF COLUMN POSITIONS ON THE PAGE OR SCREEN (E.G., 80)

 ;;DUP

 ;;S %=X,X="" S:X1]"" $P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%)

 ;;

 ;;2

 ;;DUPLICATES THE 1ST ARGUMENT INTO AN 'N'-BYTE STRING, WHERE 'N' IS 2ND ARGUMENT

 ;;STRIPBLANKS

 ;;X:X[" " "F %=0:0 Q:$A(X)-32  S X=$E(X,2,999)","F %=0:0 S %=$L(X) Q:$A(X,%)-32  S X=$E(X,1,%-1)"

 ;;

 ;;

 ;;DELETES LEADING AND TRAILING SPACES FROM THE ARGUMENT STRING

 ;;TRANSLATE

 ;;S X=$TR(X2,X1,X)

 ;;

 ;;3

 ;;REPLACES, IN ARG1, EACH OCCURRENCE OF EACH CHAR IN ARG2 WITH THE CORRESPONDING CHAR IN ARG3

 ;;PADRIGHT

 ;;S:$L(X1)<X X1=X1_$J("",X-$L(X1)) S X=X1

 ;;

 ;;2

 ;;RETURNS 'ARG1', WITH SPACES ADDED TO GENERATE A STRING 'ARG2' BYTES LONG

 ;;FILE

 ;;S X=$S('X:X,X'["(":X,'$D(@(U_$E($P(X,+X,2,99),2,99)_"0)")):X,1:$P(^(0),U))

 ;;

 ;;1

 ;;Names file for variable pointer type fields.

 ;;USER

 ;;S %=$S($D(^VA(200,+DUZ,0)):^(0),1:""),X=$S('DUZ:"??",X="#":DUZ,X="N":$P(%,U,1),X="I":$P(%,U,2),X="T":$S($D(^DIC(3.1,+$P(%,U,9),0)):$P(^(0),U,1),1:""),X="NN":$S($D(^VA(200,+DUZ,.1)):$P(^(.1),U,4),1:""),1:"??") K %

 ;;

 ;;1

 ;;RETURNS USER ATTRIBUTES: #=NUMBER,N=NAME,I=INITIAL,T=TITLE,NN=NICKNAME

 ;;VAR

 ;;Q:X  Q:$NA(@X)[U  S X=$G(@X)

 ;;

 ;;1

 ;;RETURNS VALUE OF A LOCAL VARIABLE IF IT'S THERE

 ;;DUPLICATED

 ;;S X=X

 ;;

 ;;1

 ;;Takes as argument the name of a CROSS-REFERENCED field.  Returns BOOLEAN value, 1=field value is duplicated in another entry, ""=field value is unique

 ;;NOON

 ;;N %DT,Y S %DT="XR",X="T@NOON" D ^%DT S X=+Y

 ;;D

 ;;0

 ;;RETURNS THE CURRENT DATE AND THE TIME VALUE OF 12:OO.

 ;;MID

 ;;N %DT,Y S %DT="XR",X="T@MID" D ^%DT S X=+Y

 ;;D

 ;;0

 ;;RETURNS THE CURRENT DATE AND THE TIME VALUE OF 24:00.

 ;;NUMDATE4

 ;;S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))

 ;;X

 ;;

 ;;DATE IN 'MM/DD/YYYY' FORMAT

 ;;NUMYEAR4

 ;;S:X X=1700+$E(X,1,3)

 ;;X

 ;;

 ;;YEAR NUMBER (YYYY) FOR A DATE

 ;

FUNC F I=3:1:12 S X=$T(FUNC+I),^DD("FUNC",I+87,0)=$P(X,";",3),^(9)=$P(X,";",4)

 F I=91,92 S ^DD("FUNC",I,3)="VARIABLE"

 G ^DINIT5

 ;;PRIORVALUE;Takes name of an Audited Field.  Returns as a multiple all prior values of the field, most recent first.

 ;;PRIORDATE;When it has an argument (Fieldname), returns as a multiple all prior Date/Times of auditing, most recent first.  Without an argument, it is most recent audited Date/Time for the Entry

 ;;PRIORUSER;When it has an argument (Fieldname), returns as a multiple all prior audited Users, most recent first.  Without an argument, it is most recent audited User for the Entry

 ;;MAXIMUM;Takes multiple-valued field or expression as argument.  Returns the maximum value of all the multiples.

 ;;MINIMUM;Takes multiple-valued field or expression as argument.  Returns the minimum value of all the multiples.

 ;;NEXT;Takes name of a Field. Returns the value that that field has in the next entry or sub-entry.

 ;;PREVIOUS;Takes name of a Field. Returns the value that that field has in the previous entry or sub-entry.

 ;;TOTAL;Takes multiple-valued field or expression as argument.  Returns the total of all the multiple values.

 ;;COUNT;Takes multiple-valued field or expression as argument.  Returns the number of multiples currently existing.

 ;;LAST;Takes multiple-valued field or expression as argument.  Returns the value of the last multiple.

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DINIT42   4102     printed  Feb 19, 2025@00:18:06                                                                                                                                                                                                     Page 2

DINIT42   ;SFISC/XAK-INITIALIZE VA FILEMAN ;10MAR2008

 +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       ;

 +7        IF $GET(^DD("FUNC",89,0))="DUPLICATED"

               SET DA=89

               SET DIK="^DD(""FUNC"","

               DO ^DIK

 +8        SET %=47

DD         FOR I=1:5

               SET X=$EXTRACT($TEXT(DD+I),4,999)

               SET %=%+1

               if X?.P

                   GOTO FUNC

               SET ^DD("FUNC",%,0)=$PIECE(X,";")

               SET Y=I

               FOR DU=1,2,3,9

                   SET Y=Y+1

                   SET X=$EXTRACT($TEXT(DD+Y),4,999)

                   IF X]""

                       SET ^(DU)=X

 +1       ;;PARAM

 +2       ;;S X=$S(X=""!(X'?.ANP):"",$D(DIPA($E(X,1,30))):DIPA($E(X,1,30)),1:"")

 +3       ;;

 +4       ;;

 +5       ;;RETURNS VALUE OF PARAMETER NAMED BY ARGUMENT

 +6       ;;IOM

 +7       ;;S X=$G(IOM,80)

 +8       ;;

 +9       ;;0

 +10      ;;RETURNS THE NUMBER OF COLUMN POSITIONS ON THE PAGE OR SCREEN (E.G., 80)

 +11      ;;DUP

 +12      ;;S %=X,X="" S:X1]"" $P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%)

 +13      ;;

 +14      ;;2

 +15      ;;DUPLICATES THE 1ST ARGUMENT INTO AN 'N'-BYTE STRING, WHERE 'N' IS 2ND ARGUMENT

 +16      ;;STRIPBLANKS

 +17      ;;X:X[" " "F %=0:0 Q:$A(X)-32  S X=$E(X,2,999)","F %=0:0 S %=$L(X) Q:$A(X,%)-32  S X=$E(X,1,%-1)"

 +18      ;;

 +19      ;;

 +20      ;;DELETES LEADING AND TRAILING SPACES FROM THE ARGUMENT STRING

 +21      ;;TRANSLATE

 +22      ;;S X=$TR(X2,X1,X)

 +23      ;;

 +24      ;;3

 +25      ;;REPLACES, IN ARG1, EACH OCCURRENCE OF EACH CHAR IN ARG2 WITH THE CORRESPONDING CHAR IN ARG3

 +26      ;;PADRIGHT

 +27      ;;S:$L(X1)<X X1=X1_$J("",X-$L(X1)) S X=X1

 +28      ;;

 +29      ;;2

 +30      ;;RETURNS 'ARG1', WITH SPACES ADDED TO GENERATE A STRING 'ARG2' BYTES LONG

 +31      ;;FILE

 +32      ;;S X=$S('X:X,X'["(":X,'$D(@(U_$E($P(X,+X,2,99),2,99)_"0)")):X,1:$P(^(0),U))

 +33      ;;

 +34      ;;1

 +35      ;;Names file for variable pointer type fields.

 +36      ;;USER

 +37      ;;S %=$S($D(^VA(200,+DUZ,0)):^(0),1:""),X=$S('DUZ:"??",X="#":DUZ,X="N":$P(%,U,1),X="I":$P(%,U,2),X="T":$S($D(^DIC(3.1,+$P(%,U,9),0)):$P(^(0),U,1),1:""),X="NN":$S($D(^VA(200,+DUZ,.1)):$P(^(.1),U,4),1:""),1:"??") K %

 +38      ;;

 +39      ;;1

 +40      ;;RETURNS USER ATTRIBUTES: #=NUMBER,N=NAME,I=INITIAL,T=TITLE,NN=NICKNAME

 +41      ;;VAR

 +42      ;;Q:X  Q:$NA(@X)[U  S X=$G(@X)

 +43      ;;

 +44      ;;1

 +45      ;;RETURNS VALUE OF A LOCAL VARIABLE IF IT'S THERE

 +46      ;;DUPLICATED

 +47      ;;S X=X

 +48      ;;

 +49      ;;1

 +50      ;;Takes as argument the name of a CROSS-REFERENCED field.  Returns BOOLEAN value, 1=field value is duplicated in another entry, ""=field value is unique

 +51      ;;NOON

 +52      ;;N %DT,Y S %DT="XR",X="T@NOON" D ^%DT S X=+Y

 +53      ;;D

 +54      ;;0

 +55      ;;RETURNS THE CURRENT DATE AND THE TIME VALUE OF 12:OO.

 +56      ;;MID

 +57      ;;N %DT,Y S %DT="XR",X="T@MID" D ^%DT S X=+Y

 +58      ;;D

 +59      ;;0

 +60      ;;RETURNS THE CURRENT DATE AND THE TIME VALUE OF 24:00.

 +61      ;;NUMDATE4

 +62      ;;S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))

 +63      ;;X

 +64      ;;

 +65      ;;DATE IN 'MM/DD/YYYY' FORMAT

 +66      ;;NUMYEAR4

 +67      ;;S:X X=1700+$E(X,1,3)

 +68      ;;X

 +69      ;;

 +70      ;;YEAR NUMBER (YYYY) FOR A DATE

 +71      ;

FUNC       FOR I=3:1:12

               SET X=$TEXT(FUNC+I)

               SET ^DD("FUNC",I+87,0)=$PIECE(X,";",3)

               SET ^(9)=$PIECE(X,";",4)

 +1        FOR I=91,92

               SET ^DD("FUNC",I,3)="VARIABLE"

 +2        GOTO ^DINIT5

 +3       ;;PRIORVALUE;Takes name of an Audited Field.  Returns as a multiple all prior values of the field, most recent first.

 +4       ;;PRIORDATE;When it has an argument (Fieldname), returns as a multiple all prior Date/Times of auditing, most recent first.  Without an argument, it is most recent audited Date/Time for the Entry

 +5       ;;PRIORUSER;When it has an argument (Fieldname), returns as a multiple all prior audited Users, most recent first.  Without an argument, it is most recent audited User for the Entry

 +6       ;;MAXIMUM;Takes multiple-valued field or expression as argument.  Returns the maximum value of all the multiples.

 +7       ;;MINIMUM;Takes multiple-valued field or expression as argument.  Returns the minimum value of all the multiples.

 +8       ;;NEXT;Takes name of a Field. Returns the value that that field has in the next entry or sub-entry.

 +9       ;;PREVIOUS;Takes name of a Field. Returns the value that that field has in the previous entry or sub-entry.

 +10      ;;TOTAL;Takes multiple-valued field or expression as argument.  Returns the total of all the multiple values.

 +11      ;;COUNT;Takes multiple-valued field or expression as argument.  Returns the number of multiples currently existing.

 +12      ;;LAST;Takes multiple-valued field or expression as argument.  Returns the value of the last multiple.