source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DINIT42.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DINIT42 ;SFISC-INITIALIZE VA FILEMAN ;05:50 PM 23 Mar 2001
2 ;;22.0;VA FileMan;**76**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 S %=47
5DD 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=$G(IOM,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="" S:X1]"" $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 ;;S X=$TR(X2,X1,X)
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 Q:$NA(@X)[U S X=$G(@X)
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 ;;N %DT,Y 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 ;;N %DT,Y 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 ;;NUMDATE4
67 ;;S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))
68 ;;X
69 ;;
70 ;;DATE IN 'MM/DD/YYYY' FORMAT
71 ;;NUMYEAR4
72 ;;S:X X=1700+$E(X,1,3)
73 ;;X
74 ;;
75 ;;YEAR NUMBER (YYYY) FOR A DATE
76 ;
77FUNC F I=3:1:12 S X=$T(FUNC+I),^DD("FUNC",I+87,0)=$P(X,";",3),^(9)=$P(X,";",4)
78 F I=91,92 S ^DD("FUNC",I,3)="VARIABLE"
79 G ^DINIT5
80 ;;PRIORVALUE;Takes name of an Audited Field. Returns as a multiple all prior values of the field, most recent first.
81 ;;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
82 ;;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
83 ;;MAXIMUM;Takes multiple-valued field or expression as argument. Returns the maximum value of all the multiples.
84 ;;MINIMUM;Takes multiple-valued field or expression as argument. Returns the minimum value of all the multiples.
85 ;;NEXT;Takes name of a Field. Returns the value that that field has in the next entry or sub-entry.
86 ;;PREVIOUS;Takes name of a Field. Returns the value that that field has in the previous entry or sub-entry.
87 ;;TOTAL;Takes multiple-valued field or expression as argument. Returns the total of all the multiple values.
88 ;;COUNT;Takes multiple-valued field or expression as argument. Returns the number of multiples currently existing.
89 ;;LAST;Takes multiple-valued field or expression as argument. Returns the value of the last multiple.
Note: See TracBrowser for help on using the repository browser.