- 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 Mar 13, 2025@21:31:03 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 ;
