FBPRE35 ;AISC/DMK-PRE-INIT FOR FEE BASIS ;5/24/94 09:25
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;CHECK DUZ and DUZ(0)
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
I DUZ(0)'="@" W *7,!!,"You must have programmer access (DUZ(0)='@') before running FBINIT.",!! K DIFQ Q
;
;check for routine XPDUTL (part of kernel tool kit 7.2
S X="XPDUTL" X ^%ZOSF("TEST") I '$T D K DIFQ Q
.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.",!
;
;check version of Fee Basis. If Fee is installed, must be version 3.0.
S X=+$$VERSION^XPDUTL("FB") I X,X<3 D Q
.W *7,!,"You must have Fee Basis Version 3.0 installed prior to installing version 3.5",! K DIFQ
I $D(^FBAA(161.81,6)) S X=$O(^FBAA(161.81,"B","CONTRACT HOSPITAL",0)) I X D
.N DA,DIE,DIC,DR
.S DA=X,DIE="^FBAA(161.81,",DR=".01///"_"NON-VA HOSPITAL" D ^DIE
;
VER ;determine appropriate version number
N FBI,FBV,FBVNEW,FBX,FBY
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)
.S X=+$$VERSION^XPDUTL(FBX) D:X'>0 MESS1 K:X'>0 DIFQ I X>0,X<FBVNEW D MESS2 K DIFQ
;
CLEANUP ;driver to cleanup package file entries.
N I,X
F I=1:1 S X=$P($T(OLDPKG+I),";;",2) Q:'$L(X) D DELPKG(X)
;
;driver to queue data for transmission before install
I $G(DIFQ),+$G(^DD(161,0,"VR"))=3,+$O(^FBAA(161.25,0)) D
.D RTRAN^FBAAV0
;
Q
;
MESS1 W !!,"Check your package file for the ",FBX," entry. Unable to determine version."
Q
;
MESS2 W !!,"Your version of the ",FBX," must be at least ",FBVNEW," to install this version of FEE.",*7
Q
;
V ;;package namespace;version number
;;DGYA;5.0
;;DG;5.3
;;XU;7.1
;;XT;7.2
;;IB;2.0
;;END
;
DELPKG(X) ;pass in x equal to the namespace you want deleted from
;the package file (9.4). Called to clean-up prior version init
;patches, namespace changes, etc.
Q:'$L(X)
N DIC,DIK,D,DA,Y
S DIC="^DIC(9.4,",DIC(0)="",D="C" D IX^DIC Q:'+Y
S DA=+Y,DIK=DIC
D ^DIK
Q
OLDPKG ;entries to be deleted from the package file.
;;FBBA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBPRE35 2306 printed Nov 22, 2024@17:09:55 Page 2
FBPRE35 ;AISC/DMK-PRE-INIT FOR FEE BASIS ;5/24/94 09:25
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;CHECK DUZ and DUZ(0)
+4 IF $SELECT('($DATA(DUZ)#2):1,'($DATA(DUZ(0))#2):1,'DUZ:1,1:0)
WRITE *7,!!,"*** DUZ and DUZ(0) must be defined as a valid user to initialize. ***",!!
KILL DIFQ
QUIT
+5 IF DUZ(0)'="@"
WRITE *7,!!,"You must have programmer access (DUZ(0)='@') before running FBINIT.",!!
KILL DIFQ
QUIT
+6 ;
+7 ;check for routine XPDUTL (part of kernel tool kit 7.2
+8 SET X="XPDUTL"
XECUTE ^%ZOSF("TEST")
IF '$TEST
Begin DoDot:1
+9 WRITE *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.",!
End DoDot:1
KILL DIFQ
QUIT
+10 ;
+11 ;check version of Fee Basis. If Fee is installed, must be version 3.0.
+12 SET X=+$$VERSION^XPDUTL("FB")
IF X
IF X<3
Begin DoDot:1
+13 WRITE *7,!,"You must have Fee Basis Version 3.0 installed prior to installing version 3.5",!
KILL DIFQ
End DoDot:1
QUIT
+14 IF $DATA(^FBAA(161.81,6))
SET X=$ORDER(^FBAA(161.81,"B","CONTRACT HOSPITAL",0))
IF X
Begin DoDot:1
+15 NEW DA,DIE,DIC,DR
+16 SET DA=X
SET DIE="^FBAA(161.81,"
SET DR=".01///"_"NON-VA HOSPITAL"
DO ^DIE
End DoDot:1
+17 ;
VER ;determine appropriate version number
+1 NEW FBI,FBV,FBVNEW,FBX,FBY
+2 SET FBI=1
FOR
SET FBV=$PIECE($TEXT(V+FBI),";;",2)
if FBV="END"
QUIT
SET FBI=FBI+1
SET FBVNEW=$PIECE(FBV,";",2)
SET FBX=$PIECE(FBV,";")
Begin DoDot:1
+3 SET X=+$$VERSION^XPDUTL(FBX)
if X'>0
DO MESS1
if X'>0
KILL DIFQ
IF X>0
IF X<FBVNEW
DO MESS2
KILL DIFQ
End DoDot:1
if '$DATA(DIFQ)
QUIT
+4 ;
CLEANUP ;driver to cleanup package file entries.
+1 NEW I,X
+2 FOR I=1:1
SET X=$PIECE($TEXT(OLDPKG+I),";;",2)
if '$LENGTH(X)
QUIT
DO DELPKG(X)
+3 ;
+4 ;driver to queue data for transmission before install
+5 IF $GET(DIFQ)
IF +$GET(^DD(161,0,"VR"))=3
IF +$ORDER(^FBAA(161.25,0))
Begin DoDot:1
+6 DO RTRAN^FBAAV0
End DoDot:1
+7 ;
+8 QUIT
+9 ;
MESS1 WRITE !!,"Check your package file for the ",FBX," entry. Unable to determine version."
+1 QUIT
+2 ;
MESS2 WRITE !!,"Your version of the ",FBX," must be at least ",FBVNEW," to install this version of FEE.",*7
+1 QUIT
+2 ;
V ;;package namespace;version number
+1 ;;DGYA;5.0
+2 ;;DG;5.3
+3 ;;XU;7.1
+4 ;;XT;7.2
+5 ;;IB;2.0
+6 ;;END
+7 ;
DELPKG(X) ;pass in x equal to the namespace you want deleted from
+1 ;the package file (9.4). Called to clean-up prior version init
+2 ;patches, namespace changes, etc.
+3 if '$LENGTH(X)
QUIT
+4 NEW DIC,DIK,D,DA,Y
+5 SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
DO IX^DIC
if '+Y
QUIT
+6 SET DA=+Y
SET DIK=DIC
+7 DO ^DIK
+8 QUIT
OLDPKG ;entries to be deleted from the package file.
+1 ;;FBBA
