source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPST31.m@ 813

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1VAQPST31 ;JRP/ALB - UTILITIES FOR INSTALLING EXPORTED ROUTINES;24-AUG-93
2 ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
3 ;
4EXIST(X) ;DETERMINE IF ROUTINE X EXISTS
5 ;INPUT : X - Name of routine
6 ;OUTPUT : 1 - Routine exists
7 ; 0 - Routine doesn't exist
8 ; "" - Error
9 ;
10 ;CHECK INPUT & EXISTANCE OF ^%ZOSF("TEST")
11 Q:($G(X)="") ""
12 Q:('$D(^%ZOSF("TEST"))) ""
13 ;CHECK FOR EXISTANCE
14 X ^%ZOSF("TEST") Q $T
15 ;
16LOAD(X,ARRAY) ;LOAD ROUTINE X INTO ARRAY
17 ;INPUT : X - Name of routine
18 ; ARRAY - Array to copy into (full global reference)
19 ;OUTPUT : None
20 ;NOTES : ARRAY will be in the format
21 ; ARRAY(Line_N,0)=Line number N of routine X
22 ; : ARRAY will be killed before loading routine. If routine
23 ; could not be loaded, ARRAY() will not exit.
24 ;
25 ;CHECK INPUT, KILL ARRAY, TEST FOR ^%ZOSF("LOAD")
26 Q:($G(ARRAY)="")
27 K @ARRAY
28 Q:($G(X)="")
29 Q:('$D(^%ZOSF("LOAD")))
30 ;DECLARE VARIABLES
31 N XCNP,DIF,TMP,TMP1,TMP2
32 ;SET REQUIRED VARIABLES
33 S TMP=$P(ARRAY,"(",1)
34 S TMP1=$P(ARRAY,"(",2)
35 S TMP2=$P(TMP1,")",1)
36 S:(TMP2="") DIF=TMP_"("
37 S:(TMP2'="") DIF=TMP_"("_TMP2_","
38 S XCNP=0
39 ;LOAD ROUTINE
40 X ^%ZOSF("LOAD")
41 Q
42 ;
43COPY(OLDROU,NEWROU,XCN) ;COPY ROUTINE OLDROU TO ROUTINE NEWROU
44 ;INPUT : OLDROU - Name of existing routine
45 ; NEWROU - New name for routine
46 ; XCN - Line in existing routine to begin copying from
47 ; (defaults to line 1)
48 ;OUTPUT : 0 - Success
49 ; -1 - Error
50 ;
51 ;CHECK INPUT & EXISTANCE OF ^%ZOSF("SAVE")
52 Q:($G(OLDROU)="") -1
53 Q:($G(NEWROU)="") -1
54 S XCN=+$G(XCN)
55 Q:('$D(^%ZOSF("SAVE"))) -1
56 ;CHECK FOR EXISTANCE OF OLDROU
57 Q:('$$EXIST(OLDROU)) -1
58 ;DECLARE VARIABLES
59 N ROOT1,ROOT2,X,DIE
60 S ROOT1="^UTILITY(""VAQPST"","_$J_")"
61 S ROOT2="^UTILITY(""VAQPST"","_$J_","
62 K @ROOT1
63 ;LOAD OLDROU
64 D LOAD(OLDROU,ROOT1)
65 Q:('$D(@ROOT1)) -1
66 ;CALL TO ^%ZOSF("SAVE") START WITH LINE AFTER XCN. SUBTRACT
67 ; ONE FROM THE VALUE PASSED TO MATCH STATED VALUE.
68 S XCN=XCN-1
69 ;SAVE OLDROU AS NEWROU
70 S X=NEWROU
71 S DIE=ROOT2
72 X ^%ZOSF("SAVE")
73 K @ROOT1
74 ;HAVE TO ASSUME THAT SAVE WAS SUCCESSFUL
75 Q 0
76 ;
77SECOND(ROU,STRIP) ;RETURN SECOND LINE OF ROUTINE ROU
78 ;INPUT : ROU - Name of routine
79 ; STRIP - Flad indicating of leading <TAB>;; should be stripped
80 ; If 1, strip <TAB>;; (default)
81 ; If 0, don't strip <TAB>;;
82 ;OUTPUT : Second line of ROU
83 ; NULL returned on error
84 ;
85 ;CHECK INPUT
86 Q:($G(ROU)="") ""
87 Q:('$$EXIST(ROU)) ""
88 S:($G(STRIP)="") STRIP=1
89 ;DECLARE VARIABLES
90 N ROOT,LINE2
91 S ROOT="^UTILITY(""VAQPST"","_$J_")"
92 ;LOAD ROUTINE
93 D LOAD(ROU,ROOT)
94 Q:('$D(@ROOT)) ""
95 ;GET SECOND LINE
96 S LINE2=$G(@ROOT@(2,0))
97 ;STRIP LEADING <TAB>;;
98 S:(STRIP) LINE2=$P(LINE2,";;",2,$L(LINE2,";;"))
99 K @ROOT
100 Q LINE2
Note: See TracBrowser for help on using the repository browser.