File:  [Coherent Logic Development] / freem_fileman / Attic / DINIT42.m
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Mon Apr 28 14:10:44 2025 UTC (5 weeks, 4 days ago) by snw
Branches: CoherentLogicDevelopment
CVS tags: start
Initial commit

DINIT42	;SFISC/XAK-INITIALIZE VA FILEMAN ;1/10/91  1:43 PM
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	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=$S($D(IOM):IOM,1:80)
	;;
	;;0
	;;RETURNS THE NUMBER OF COLUMN POSITIONS ON THE PAGE OR SCREEN (E.G., 80)
	;;DUP
	;;S %=X,X="" Q:X1=""  S $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
	;;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
	;;
	;;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[U!(X["$C(94)")!X  S X=$S($D(@X):@X,1:"")
	;;
	;;1
	;;RETURNS VALUE OF A LOCAL VARIABLE IF IT'S THERE
	;;SETDATA
	;;S X1=X
	;;
	;;2
	;;SETS FIRST ARGUMENT EQUAL TO THE SECOND ARGUMENT
	;;NOON
	;;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
	;;S %DT="XR",X="T@MID" D ^%DT S X=+Y
	;;D
	;;0
	;;RETURNS THE CURRENT DATE AND THE TIME VALUE OF 24:00.
	;;
FUNC	F I=2:1:8 S X=$T(FUNC+I),^DD("FUNC",I+91,0)=$P(X,";",3),^(9)=$P(X,";",4)
	G ^DINIT5
	;;MAXIMUM;TAKES MULTIPLE-VALUED FIELD AS ARGUMENT.  RETURNS THE MAXIMUM VALUE OF ALL THE MULTIPLES.
	;;MINIMUM;TAKES MULTIPLE-VALUED FIELD AS ARGUMENT.  RETURNS THE MINIMUM VALUE OF ALL THE MULTIPLES.
	;;NEXT;TAKES SINGLE-VALUED FIELD AS ARGUMENT.  RETURNS THE VALUE THAT THAT FIELD HAS IN THE NEXT ENTRY OR SUB-ENTRY.
	;;PREVIOUS;TAKES SINGLE-VALUED FIELD AS ARGUMENT.  RETURNS THE VALUE THAT THAT FIELD HAS IN THE PREVIOUS ENTRY OR SUB-ENTRY.
	;;TOTAL;TAKES MULTIPLE-VALUED FIELD AS ARGUMENT.  RETURNS THE TOTAL OF ALL THE MULTIPLES FOR WHICH THERE ARE VALUES.
	;;COUNT;TAKES MULTIPLE-VALUED FIELD (OR FILE NAME) AS ARGUMENT.  RETURNS THE NUMBER OF MULTIPLES CURRENTLY EXISTING.
	;;LAST;TAKES MULTIPLE-VALUED FIELD NAME AS ARGUMENT.  RETURNS THE VALUE OF THE LAST MULTIPLE.

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>