| [613] | 1 | FBPRE35 ;AISC/DMK-PRE-INIT FOR FEE BASIS ;5/24/94 09:25
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;CHECK DUZ and DUZ(0)
|
|---|
| 5 | I $S('($D(DUZ)#2):1,'($D(DUZ(0))#2):1,'DUZ:1,1:0) W *7,!!,"*** DUZ and DUZ(0) must be defined as a valid user to initialize. ***",!! K DIFQ Q
|
|---|
| 6 | I DUZ(0)'="@" W *7,!!,"You must have programmer access (DUZ(0)='@') before running FBINIT.",!! K DIFQ Q
|
|---|
| 7 | ;
|
|---|
| 8 | ;check for routine XPDUTL (part of kernel tool kit 7.2
|
|---|
| 9 | S X="XPDUTL" X ^%ZOSF("TEST") I '$T D K DIFQ Q
|
|---|
| 10 | .W *7,!,"Routine XPDUTL, part of Kernel Tool Kit 7.2 was not found on",!,"your system. This must be installed prior to installing this",!,"version of Fee Basis.",!
|
|---|
| 11 | ;
|
|---|
| 12 | ;check version of Fee Basis. If Fee is installed, must be version 3.0.
|
|---|
| 13 | S X=+$$VERSION^XPDUTL("FB") I X,X<3 D Q
|
|---|
| 14 | .W *7,!,"You must have Fee Basis Version 3.0 installed prior to installing version 3.5",! K DIFQ
|
|---|
| 15 | I $D(^FBAA(161.81,6)) S X=$O(^FBAA(161.81,"B","CONTRACT HOSPITAL",0)) I X D
|
|---|
| 16 | .N DA,DIE,DIC,DR
|
|---|
| 17 | .S DA=X,DIE="^FBAA(161.81,",DR=".01///"_"NON-VA HOSPITAL" D ^DIE
|
|---|
| 18 | ;
|
|---|
| 19 | VER ;determine appropriate version number
|
|---|
| 20 | N FBI,FBV,FBVNEW,FBX,FBY
|
|---|
| 21 | S FBI=1 F S FBV=$P($T(V+FBI),";;",2) Q:FBV="END" S FBI=FBI+1,FBVNEW=$P(FBV,";",2),FBX=$P(FBV,";") D Q:'$D(DIFQ)
|
|---|
| 22 | .S X=+$$VERSION^XPDUTL(FBX) D:X'>0 MESS1 K:X'>0 DIFQ I X>0,X<FBVNEW D MESS2 K DIFQ
|
|---|
| 23 | ;
|
|---|
| 24 | CLEANUP ;driver to cleanup package file entries.
|
|---|
| 25 | N I,X
|
|---|
| 26 | F I=1:1 S X=$P($T(OLDPKG+I),";;",2) Q:'$L(X) D DELPKG(X)
|
|---|
| 27 | ;
|
|---|
| 28 | ;driver to queue data for transmission before install
|
|---|
| 29 | I $G(DIFQ),+$G(^DD(161,0,"VR"))=3,+$O(^FBAA(161.25,0)) D
|
|---|
| 30 | .D RTRAN^FBAAV0
|
|---|
| 31 | ;
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | MESS1 W !!,"Check your package file for the ",FBX," entry. Unable to determine version."
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | MESS2 W !!,"Your version of the ",FBX," must be at least ",FBVNEW," to install this version of FEE.",*7
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | V ;;package namespace;version number
|
|---|
| 41 | ;;DGYA;5.0
|
|---|
| 42 | ;;DG;5.3
|
|---|
| 43 | ;;XU;7.1
|
|---|
| 44 | ;;XT;7.2
|
|---|
| 45 | ;;IB;2.0
|
|---|
| 46 | ;;END
|
|---|
| 47 | ;
|
|---|
| 48 | DELPKG(X) ;pass in x equal to the namespace you want deleted from
|
|---|
| 49 | ;the package file (9.4). Called to clean-up prior version init
|
|---|
| 50 | ;patches, namespace changes, etc.
|
|---|
| 51 | Q:'$L(X)
|
|---|
| 52 | N DIC,DIK,D,DA,Y
|
|---|
| 53 | S DIC="^DIC(9.4,",DIC(0)="",D="C" D IX^DIC Q:'+Y
|
|---|
| 54 | S DA=+Y,DIK=DIC
|
|---|
| 55 | D ^DIK
|
|---|
| 56 | Q
|
|---|
| 57 | OLDPKG ;entries to be deleted from the package file.
|
|---|
| 58 | ;;FBBA
|
|---|
