1 | KMPDUT1 ;OAK/RAK - Test Lab Utility ;6/21/05 10:17
|
---|
2 | ;;2.0;CAPACITY MANAGEMENT TOOLS;**4**;Mar 22, 2002
|
---|
3 | ;
|
---|
4 | TL ;-entry point for setting up database as a test lab
|
---|
5 | ;
|
---|
6 | ; patch "KMPR*2.0*2" must be installed
|
---|
7 | I '$$PATCH^XPDUTL("KMPR*2.0*2") D Q
|
---|
8 | .W !?3,"Patch 'KMPR*2.0*2' must be installed to run this routine!",!!
|
---|
9 | ;
|
---|
10 | N DIR,ERROR,IEN,FDA,ROUTINE,X,Y,Z
|
---|
11 | S DIR(0)="YO",DIR("B")="N"
|
---|
12 | S DIR("A")="Do you want to set this up as a Test Lab database for Capacity Planning"
|
---|
13 | W ! D ^DIR
|
---|
14 | I 'Y W !!?3,$C(7),"No action taken!" Q
|
---|
15 | ;
|
---|
16 | W !!?3,"Setting up database..."
|
---|
17 | S ^KMPD(8973,"TEST LAB")=1
|
---|
18 | W "done"
|
---|
19 | S IEN=$O(^KMPD(8973,0)) Q:'IEN
|
---|
20 | W !
|
---|
21 | W !?3,"Updating RUM Weeks to Keep Data = 99 ..."
|
---|
22 | W !?3," HL7 Weeks to Keep Data = 99 ..."
|
---|
23 | W !?3," Timing Weeks to Keep Data = 99 ..."
|
---|
24 | S FDA($J,8973,IEN_",",2.11)=99
|
---|
25 | S FDA($J,8973,IEN_",",3.11)=99
|
---|
26 | S FDA($J,8973,IEN_",",4.11)=99
|
---|
27 | D FILE^DIE("","FDA($J)","ERROR")
|
---|
28 | I $D(ERROR) D MSG^DIALOG("W","",60,10,"ERROR")
|
---|
29 | W "done"
|
---|
30 | W !
|
---|
31 | W !?3,"Saving ZOSVKRT as %ZOSVKR ..."
|
---|
32 | D ROUINQ^KMPDU2(.ROUTINE,"ZOSVKRT")
|
---|
33 | D:$D(ROUTINE) ROUSAVE^KMPDU3(.Z,"%ZOSVKR",.ROUTINE)
|
---|
34 | W "done"
|
---|
35 | W !
|
---|
36 | W !?3,"Deleting old ^KMPTMP(""KMPR"" data..."
|
---|
37 | K ^KMPTMP("KMPR")
|
---|
38 | W "done"
|
---|
39 | S IEN=$O(^DIC(4.2,"B","FO-ALBANY.MED.VA.GOV",0))
|
---|
40 | I IEN D
|
---|
41 | .K FDA,ERROR
|
---|
42 | .W !!?3,"Setting FLAGS to SEND for domain FO-ALBANY.MED.VA.GOV..."
|
---|
43 | .S FDA($J,4.2,IEN_",",1)="S"
|
---|
44 | .D FILE^DIE("","FDA($J)","ERROR")
|
---|
45 | .D:$D(ROUTINE) ROUSAVE^KMPDU3(.Z,"%ZOSVKR",.ROUTINE)
|
---|
46 | .W "done"
|
---|
47 | ;
|
---|
48 | W !!?3,"*** This is now a Capacity Planning Test Lab database ***"
|
---|
49 | ;
|
---|
50 | Q
|
---|
51 | ;
|
---|
52 | TESTLAB() ;-extrinsic - test for test lab database
|
---|
53 | ;-----------------------------------------------------------------------------
|
---|
54 | ; return: "0" - not a test lab database
|
---|
55 | ; "1^TESTLAB-" - it is a test lab database
|
---|
56 | ;-----------------------------------------------------------------------------
|
---|
57 | N TL
|
---|
58 | S TL=+$G(^KMPD(8973,"TEST LAB"))
|
---|
59 | Q $S('TL:0,1:"1^TESTLAB-")
|
---|