source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUT1.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1KMPDUT1 ;OAK/RAK - Test Lab Utility ;6/21/05 10:17
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;**4**;Mar 22, 2002
3 ;
4TL ;-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 ;
52TESTLAB() ;-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-")
Note: See TracBrowser for help on using the repository browser.