VAQPST30 ;JRP/ALB - INSTALL EXPORTED ROUTINES;24-AUG-93
;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
EXPORT ;MAIN ENTRY POINT
;INPUT : None
;OUTPUT : None
;NOTES : The following routines will be installed
; GMTSPDX - Extracts Health Summary components
; IBAPDX -+
; IBAPDX0 |- Extract/Display Integrated Billing info
; IBAPDX1 -+
;
;DECLARE VARIABLES
N OFFSET,EXPORT,INSTALL,VERSION,PATCHES,TEXT,EXIST,TMP
N INSVER,INSPAT,INSLN2,SPOT
W !!!,?2,">>> Exported routines will now be loaded",!
;LOOP THROUGH EXPORTED ROUTINES
F OFFSET=1:1 S TEXT=$T(RTN+OFFSET) S TEXT=$P(TEXT,";;",2,$L(TEXT,";;")) Q:(TEXT="") D
.S EXPORT=$P(TEXT,";",1)
.S INSTALL=$P(TEXT,";",2)
.S VERSION=$P(TEXT,";",3)
.S PATCHES=$P(TEXT,";",4)
.Q:((EXPORT="")!(INSTALL=""))
.;MAKE SURE EXPORTED ROUTINE EXISTS
.I ('$$EXIST^VAQPST31(EXPORT)) D Q
..W !,?5,$C(7),"** Exported routine ",EXPORT," does not exist"
.;CHECK FOR EXISTANCE OF NEW ROUTINE
.S EXIST=$$EXIST^VAQPST31(INSTALL)
.;NEW ROUTINE DOES NOT EXIST
.I ('EXIST) D Q
..W !,?5,"Copying routine ",EXPORT," into ",INSTALL
..S TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
..W ?50,$S('TMP:"Done",1:$C(7)_"** Error")
.;GET LINE 2 OF EXISTING ROUTINE
.S INSLN2=$$SECOND^VAQPST31(INSTALL,1)
.;DETERMINE VERSION OF EXISTING ROUTINE (STRIP LEADING/LEADING ALPHAS)
.S INSVER=$P(INSLN2,";",1)
.S INSVER=$TR(INSVER," ","")
.F SPOT=1:1:$L(INSVER) S TMP=$E(INSVER,SPOT) Q:((TMP?1N)!(TMP=""))
.S INSVER=+$E(INSVER,SPOT,$L(INSVER))
.S:((INSVER'?1.N1"."1.N)&(INSVER'?1.N)&(INSVER'?1"."1.N)) INSVER=""
.I (INSVER="") D Q
..W !,?5,$C(7),"** Could not determine if ",INSTALL," should be overwritten with ",EXPORT
.;CHECK EXISTING VERSION AGAINST EXPORTED VERSION
.I (INSVER>VERSION) D Q
..W !,?5,"Copying of ",EXPORT," into ",INSTALL," not required"
.I (INSVER<VERSION) D Q
..W !,?5,"Copying routine ",EXPORT," into ",INSTALL
..S TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
..W ?50,$S('TMP:"Done",1:$C(7)_"** Error")
.;DETERMINE PATCHES APPLIED TO EXISTING ROUTINE (STRIP SPACES AND STARS)
.S INSPAT=$P(INSLN2,";",3)
.S INSPAT=$TR(INSPAT,"*","")
.S INSPAT=$TR(INSPAT," ","")
.;CHECK FOR PATCH INSTALLATIONS
.S EXIST=0
.I ((INSPAT'="")&(PATCHES'="")) D
..S PATCHES=","_PATCHES_","
..F SPOT=1:1:$L(INSPAT,",") D Q:(EXIST)
...S TMP=$P(INSPAT,",",SPOT)
...Q:(TMP="")
...S TMP=","_TMP_","
...S:(PATCHES[TMP) EXIST=1
..S PATCHES=$P(PATCHES,",",2,($L(PATCHES,",")-1))
.S:((INSPAT="")&(PATCHES="")) EXIST=1
.I (EXIST) D Q
..W !,?5,"Copying of ",EXPORT," into ",INSTALL," not required"
.W !,?5,"Copying routine ",EXPORT," into ",INSTALL
.S TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
.W ?50,$S('TMP:"Done",1:$C(7)_"** Error")
W !!,?2,"Done",!!!
Q
;
RTN ;ROUTINES TO INSTALL
;;VAQPSE01;GMTSPDX;2.5;8
;;VAQPSE02;IBAPDX;1.5;15
;;VAQPSE03;IBAPDX0;1.5;15
;;VAQPSE04;IBAPDX1;1.5;15
;;
;;
;FORMAT OF TEXT LINES
; ;;EXPORT;INSTALL;VERSION;PATCHES
;
; EXPORT - Routine name exported as (ex: VAQGMTS)
; INSTALL - Routine name to install as (ex: GMTSPDX)
; VERSION - Version number of exported routine (ex: 1.5)
; PATCHES - List of patches that may have been applied
; (ex: 1,2,3) (ex: 1)
;
; Routine is installed if one of the following conditions is TRUE
; 1) The routine INSTALL does not exist
; 2) The routine INSTALL exists and
; a) VERSION is greater or equal to version of existing routine
; b) Patches to INSTALL do not include entries in PATCHES
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST30 3595 printed Nov 22, 2024@17:36:37 Page 2
VAQPST30 ;JRP/ALB - INSTALL EXPORTED ROUTINES;24-AUG-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
EXPORT ;MAIN ENTRY POINT
+1 ;INPUT : None
+2 ;OUTPUT : None
+3 ;NOTES : The following routines will be installed
+4 ; GMTSPDX - Extracts Health Summary components
+5 ; IBAPDX -+
+6 ; IBAPDX0 |- Extract/Display Integrated Billing info
+7 ; IBAPDX1 -+
+8 ;
+9 ;DECLARE VARIABLES
+10 NEW OFFSET,EXPORT,INSTALL,VERSION,PATCHES,TEXT,EXIST,TMP
+11 NEW INSVER,INSPAT,INSLN2,SPOT
+12 WRITE !!!,?2,">>> Exported routines will now be loaded",!
+13 ;LOOP THROUGH EXPORTED ROUTINES
+14 FOR OFFSET=1:1
SET TEXT=$TEXT(RTN+OFFSET)
SET TEXT=$PIECE(TEXT,";;",2,$LENGTH(TEXT,";;"))
if (TEXT="")
QUIT
Begin DoDot:1
+15 SET EXPORT=$PIECE(TEXT,";",1)
+16 SET INSTALL=$PIECE(TEXT,";",2)
+17 SET VERSION=$PIECE(TEXT,";",3)
+18 SET PATCHES=$PIECE(TEXT,";",4)
+19 if ((EXPORT="")!(INSTALL=""))
QUIT
+20 ;MAKE SURE EXPORTED ROUTINE EXISTS
+21 IF ('$$EXIST^VAQPST31(EXPORT))
Begin DoDot:2
+22 WRITE !,?5,$CHAR(7),"** Exported routine ",EXPORT," does not exist"
End DoDot:2
QUIT
+23 ;CHECK FOR EXISTANCE OF NEW ROUTINE
+24 SET EXIST=$$EXIST^VAQPST31(INSTALL)
+25 ;NEW ROUTINE DOES NOT EXIST
+26 IF ('EXIST)
Begin DoDot:2
+27 WRITE !,?5,"Copying routine ",EXPORT," into ",INSTALL
+28 SET TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
+29 WRITE ?50,$SELECT('TMP:"Done",1:$CHAR(7)_"** Error")
End DoDot:2
QUIT
+30 ;GET LINE 2 OF EXISTING ROUTINE
+31 SET INSLN2=$$SECOND^VAQPST31(INSTALL,1)
+32 ;DETERMINE VERSION OF EXISTING ROUTINE (STRIP LEADING/LEADING ALPHAS)
+33 SET INSVER=$PIECE(INSLN2,";",1)
+34 SET INSVER=$TRANSLATE(INSVER," ","")
+35 FOR SPOT=1:1:$LENGTH(INSVER)
SET TMP=$EXTRACT(INSVER,SPOT)
if ((TMP?1N)!(TMP=""))
QUIT
+36 SET INSVER=+$EXTRACT(INSVER,SPOT,$LENGTH(INSVER))
+37 if ((INSVER'?1.N1"."1.N)&(INSVER'?1.N)&(INSVER'?1"."1.N))
SET INSVER=""
+38 IF (INSVER="")
Begin DoDot:2
+39 WRITE !,?5,$CHAR(7),"** Could not determine if ",INSTALL," should be overwritten with ",EXPORT
End DoDot:2
QUIT
+40 ;CHECK EXISTING VERSION AGAINST EXPORTED VERSION
+41 IF (INSVER>VERSION)
Begin DoDot:2
+42 WRITE !,?5,"Copying of ",EXPORT," into ",INSTALL," not required"
End DoDot:2
QUIT
+43 IF (INSVER<VERSION)
Begin DoDot:2
+44 WRITE !,?5,"Copying routine ",EXPORT," into ",INSTALL
+45 SET TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
+46 WRITE ?50,$SELECT('TMP:"Done",1:$CHAR(7)_"** Error")
End DoDot:2
QUIT
+47 ;DETERMINE PATCHES APPLIED TO EXISTING ROUTINE (STRIP SPACES AND STARS)
+48 SET INSPAT=$PIECE(INSLN2,";",3)
+49 SET INSPAT=$TRANSLATE(INSPAT,"*","")
+50 SET INSPAT=$TRANSLATE(INSPAT," ","")
+51 ;CHECK FOR PATCH INSTALLATIONS
+52 SET EXIST=0
+53 IF ((INSPAT'="")&(PATCHES'=""))
Begin DoDot:2
+54 SET PATCHES=","_PATCHES_","
+55 FOR SPOT=1:1:$LENGTH(INSPAT,",")
Begin DoDot:3
+56 SET TMP=$PIECE(INSPAT,",",SPOT)
+57 if (TMP="")
QUIT
+58 SET TMP=","_TMP_","
+59 if (PATCHES[TMP)
SET EXIST=1
End DoDot:3
if (EXIST)
QUIT
+60 SET PATCHES=$PIECE(PATCHES,",",2,($LENGTH(PATCHES,",")-1))
End DoDot:2
+61 if ((INSPAT="")&(PATCHES=""))
SET EXIST=1
+62 IF (EXIST)
Begin DoDot:2
+63 WRITE !,?5,"Copying of ",EXPORT," into ",INSTALL," not required"
End DoDot:2
QUIT
+64 WRITE !,?5,"Copying routine ",EXPORT," into ",INSTALL
+65 SET TMP=$$COPY^VAQPST31(EXPORT,INSTALL,3)
+66 WRITE ?50,$SELECT('TMP:"Done",1:$CHAR(7)_"** Error")
End DoDot:1
+67 WRITE !!,?2,"Done",!!!
+68 QUIT
+69 ;
RTN ;ROUTINES TO INSTALL
+1 ;;VAQPSE01;GMTSPDX;2.5;8
+2 ;;VAQPSE02;IBAPDX;1.5;15
+3 ;;VAQPSE03;IBAPDX0;1.5;15
+4 ;;VAQPSE04;IBAPDX1;1.5;15
+5 ;;
+6 ;;
+7 ;FORMAT OF TEXT LINES
+8 ; ;;EXPORT;INSTALL;VERSION;PATCHES
+9 ;
+10 ; EXPORT - Routine name exported as (ex: VAQGMTS)
+11 ; INSTALL - Routine name to install as (ex: GMTSPDX)
+12 ; VERSION - Version number of exported routine (ex: 1.5)
+13 ; PATCHES - List of patches that may have been applied
+14 ; (ex: 1,2,3) (ex: 1)
+15 ;
+16 ; Routine is installed if one of the following conditions is TRUE
+17 ; 1) The routine INSTALL does not exist
+18 ; 2) The routine INSTALL exists and
+19 ; a) VERSION is greater or equal to version of existing routine
+20 ; b) Patches to INSTALL do not include entries in PATCHES
+21 ;
