Return to DINIT42.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DINIT42	;SFISC/XAK-INITIALIZE VA FILEMAN ;1/10/91  1:43 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	S %=47
    5: 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
    6: 	;;PARAM
    7: 	;;S X=$S(X=""!(X'?.ANP):"",$D(DIPA($E(X,1,30))):DIPA($E(X,1,30)),1:"")
    8: 	;;
    9: 	;;
   10: 	;;RETURNS VALUE OF PARAMETER NAMED BY ARGUMENT
   11: 	;;IOM
   12: 	;;S X=$S($D(IOM):IOM,1:80)
   13: 	;;
   14: 	;;0
   15: 	;;RETURNS THE NUMBER OF COLUMN POSITIONS ON THE PAGE OR SCREEN (E.G., 80)
   16: 	;;DUP
   17: 	;;S %=X,X="" Q:X1=""  S $P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%)
   18: 	;;
   19: 	;;2
   20: 	;;DUPLICATES THE 1ST ARGUMENT INTO AN 'N'-BYTE STRING, WHERE 'N' IS 2ND ARGUMENT
   21: 	;;STRIPBLANKS
   22: 	;;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)"
   23: 	;;
   24: 	;;
   25: 	;;DELETES LEADING AND TRAILING SPACES FROM THE ARGUMENT STRING
   26: 	;;TRANSLATE
   27: 	;;X "F %=1:1:$L(X1) F %Y=0:0 S %Y=$F(X2,$E(X1,%),%Y) Q:'%Y  S I=$E(X,%),X2=$E(X2,1,%Y-2)_I_$E(X2,%Y,999) S:I="""" %Y=%Y-1" S X=X2
   28: 	;;
   29: 	;;3
   30: 	;;REPLACES, IN ARG1, EACH OCCURRENCE OF EACH CHAR IN ARG2 WITH THE CORRESPONDING CHAR IN ARG3
   31: 	;;PADRIGHT
   32: 	;;S:$L(X1)<X X1=X1_$J("",X-$L(X1)) S X=X1
   33: 	;;
   34: 	;;2
   35: 	;;RETURNS 'ARG1', WITH SPACES ADDED TO GENERATE A STRING 'ARG2' BYTES LONG
   36: 	;;FILE
   37: 	;;S X=$S('X:X,X'["(":X,'$D(@(U_$E($P(X,+X,2,99),2,99)_"0)")):X,1:$P(^(0),U))
   38: 	;;
   39: 	;;1
   40: 	;;Names file for variable pointer type fields.
   41: 	;;USER
   42: 	;;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 %
   43: 	;;
   44: 	;;1
   45: 	;;RETURNS USER ATTRIBUTES: #=NUMBER,N=NAME,I=INITIAL,T=TITLE,NN=NICKNAME
   46: 	;;VAR
   47: 	;;Q:X[U!(X["$C(94)")!X  S X=$S($D(@X):@X,1:"")
   48: 	;;
   49: 	;;1
   50: 	;;RETURNS VALUE OF A LOCAL VARIABLE IF IT'S THERE
   51: 	;;SETDATA
   52: 	;;S X1=X
   53: 	;;
   54: 	;;2
   55: 	;;SETS FIRST ARGUMENT EQUAL TO THE SECOND ARGUMENT
   56: 	;;NOON
   57: 	;;S %DT="XR",X="T@NOON" D ^%DT S X=+Y
   58: 	;;D
   59: 	;;0
   60: 	;;RETURNS THE CURRENT DATE AND THE TIME VALUE OF 12:OO.
   61: 	;;MID
   62: 	;;S %DT="XR",X="T@MID" D ^%DT S X=+Y
   63: 	;;D
   64: 	;;0
   65: 	;;RETURNS THE CURRENT DATE AND THE TIME VALUE OF 24:00.
   66: 	;;
   67: FUNC	F I=2:1:8 S X=$T(FUNC+I),^DD("FUNC",I+91,0)=$P(X,";",3),^(9)=$P(X,";",4)
   68: 	G ^DINIT5
   69: 	;;MAXIMUM;TAKES MULTIPLE-VALUED FIELD AS ARGUMENT.  RETURNS THE MAXIMUM VALUE OF ALL THE MULTIPLES.
   70: 	;;MINIMUM;TAKES MULTIPLE-VALUED FIELD AS ARGUMENT.  RETURNS THE MINIMUM VALUE OF ALL THE MULTIPLES.
   71: 	;;NEXT;TAKES SINGLE-VALUED FIELD AS ARGUMENT.  RETURNS THE VALUE THAT THAT FIELD HAS IN THE NEXT ENTRY OR SUB-ENTRY.
   72: 	;;PREVIOUS;TAKES SINGLE-VALUED FIELD AS ARGUMENT.  RETURNS THE VALUE THAT THAT FIELD HAS IN THE PREVIOUS ENTRY OR SUB-ENTRY.
   73: 	;;TOTAL;TAKES MULTIPLE-VALUED FIELD AS ARGUMENT.  RETURNS THE TOTAL OF ALL THE MULTIPLES FOR WHICH THERE ARE VALUES.
   74: 	;;COUNT;TAKES MULTIPLE-VALUED FIELD (OR FILE NAME) AS ARGUMENT.  RETURNS THE NUMBER OF MULTIPLES CURRENTLY EXISTING.
   75: 	;;LAST;TAKES MULTIPLE-VALUED FIELD NAME AS ARGUMENT.  RETURNS THE VALUE OF THE LAST MULTIPLE.