source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPST30.m@ 1710

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1VAQPST30 ;JRP/ALB - INSTALL EXPORTED ROUTINES;24-AUG-93
2 ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
3EXPORT ;MAIN ENTRY POINT
4 ;INPUT : None
5 ;OUTPUT : None
6 ;NOTES : The following routines will be installed
7 ; GMTSPDX - Extracts Health Summary components
8 ; IBAPDX -+
9 ; IBAPDX0 |- Extract/Display Integrated Billing info
10 ; IBAPDX1 -+
11 ;
12 ;DECLARE VARIABLES
13 N OFFSET,EXPORT,INSTALL,VERSION,PATCHES,TEXT,EXIST,TMP
14 N INSVER,INSPAT,INSLN2,SPOT
15 W !!!,?2,">>> Exported routines will now be loaded",!
16 ;LOOP THROUGH EXPORTED ROUTINES
17 F OFFSET=1:1 S TEXT=$T(RTN+OFFSET) S TEXT=$P(TEXT,";;",2,$L(TEXT,";;")) Q:(TEXT="") D
18 .S EXPORT=$P(TEXT,";",1)
19 .S INSTALL=$P(TEXT,";",2)
20 .S VERSION=$P(TEXT,";",3)
21 .S PATCHES=$P(TEXT,";",4)
22 .Q:((EXPORT="")!(INSTALL=""))
23 .;MAKE SURE EXPORTED ROUTINE EXISTS
24 .I ('$$EXIST^VAQPST31(EXPORT)) D Q
25 ..W !,?5,$C(7),"** Exported routine ",EXPORT," does not exist"
26 .;CHECK FOR EXISTANCE OF NEW ROUTINE
27 .S EXIST=$$EXIST^VAQPST31(INSTALL)
28 .;NEW ROUTINE DOES NOT EXIST
29 .I ('EXIST) D Q
30 ..W !,?5,"Copying routine ",EXPORT," into ",INSTALL
31 ..S TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
32 ..W ?50,$S('TMP:"Done",1:$C(7)_"** Error")
33 .;GET LINE 2 OF EXISTING ROUTINE
34 .S INSLN2=$$SECOND^VAQPST31(INSTALL,1)
35 .;DETERMINE VERSION OF EXISTING ROUTINE (STRIP LEADING/LEADING ALPHAS)
36 .S INSVER=$P(INSLN2,";",1)
37 .S INSVER=$TR(INSVER," ","")
38 .F SPOT=1:1:$L(INSVER) S TMP=$E(INSVER,SPOT) Q:((TMP?1N)!(TMP=""))
39 .S INSVER=+$E(INSVER,SPOT,$L(INSVER))
40 .S:((INSVER'?1.N1"."1.N)&(INSVER'?1.N)&(INSVER'?1"."1.N)) INSVER=""
41 .I (INSVER="") D Q
42 ..W !,?5,$C(7),"** Could not determine if ",INSTALL," should be overwritten with ",EXPORT
43 .;CHECK EXISTING VERSION AGAINST EXPORTED VERSION
44 .I (INSVER>VERSION) D Q
45 ..W !,?5,"Copying of ",EXPORT," into ",INSTALL," not required"
46 .I (INSVER<VERSION) D Q
47 ..W !,?5,"Copying routine ",EXPORT," into ",INSTALL
48 ..S TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
49 ..W ?50,$S('TMP:"Done",1:$C(7)_"** Error")
50 .;DETERMINE PATCHES APPLIED TO EXISTING ROUTINE (STRIP SPACES AND STARS)
51 .S INSPAT=$P(INSLN2,";",3)
52 .S INSPAT=$TR(INSPAT,"*","")
53 .S INSPAT=$TR(INSPAT," ","")
54 .;CHECK FOR PATCH INSTALLATIONS
55 .S EXIST=0
56 .I ((INSPAT'="")&(PATCHES'="")) D
57 ..S PATCHES=","_PATCHES_","
58 ..F SPOT=1:1:$L(INSPAT,",") D Q:(EXIST)
59 ...S TMP=$P(INSPAT,",",SPOT)
60 ...Q:(TMP="")
61 ...S TMP=","_TMP_","
62 ...S:(PATCHES[TMP) EXIST=1
63 ..S PATCHES=$P(PATCHES,",",2,($L(PATCHES,",")-1))
64 .S:((INSPAT="")&(PATCHES="")) EXIST=1
65 .I (EXIST) D Q
66 ..W !,?5,"Copying of ",EXPORT," into ",INSTALL," not required"
67 .W !,?5,"Copying routine ",EXPORT," into ",INSTALL
68 .S TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
69 .W ?50,$S('TMP:"Done",1:$C(7)_"** Error")
70 W !!,?2,"Done",!!!
71 Q
72 ;
73RTN ;ROUTINES TO INSTALL
74 ;;VAQPSE01;GMTSPDX;2.5;8
75 ;;VAQPSE02;IBAPDX;1.5;15
76 ;;VAQPSE03;IBAPDX0;1.5;15
77 ;;VAQPSE04;IBAPDX1;1.5;15
78 ;;
79 ;;
80 ;FORMAT OF TEXT LINES
81 ; ;;EXPORT;INSTALL;VERSION;PATCHES
82 ;
83 ; EXPORT - Routine name exported as (ex: VAQGMTS)
84 ; INSTALL - Routine name to install as (ex: GMTSPDX)
85 ; VERSION - Version number of exported routine (ex: 1.5)
86 ; PATCHES - List of patches that may have been applied
87 ; (ex: 1,2,3) (ex: 1)
88 ;
89 ; Routine is installed if one of the following conditions is TRUE
90 ; 1) The routine INSTALL does not exist
91 ; 2) The routine INSTALL exists and
92 ; a) VERSION is greater or equal to version of existing routine
93 ; b) Patches to INSTALL do not include entries in PATCHES
94 ;
Note: See TracBrowser for help on using the repository browser.