KMPDUT1 ;OAK/RAK - Test Lab Utility ;6/21/05 10:17
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
TL ;-entry point for setting up database as a test lab
;
; patch "KMPR*2.0*2" must be installed
I '$$PATCH^XPDUTL("KMPR*2.0*2") D Q
.W !?3,"Patch 'KMPR*2.0*2' must be installed to run this routine!",!!
;
N DIR,ERROR,IEN,FDA,ROUTINE,X,Y,Z
S DIR(0)="YO",DIR("B")="N"
S DIR("A")="Do you want to set this up as a Test Lab database for Capacity Planning"
W ! D ^DIR
I 'Y W !!?3,$C(7),"No action taken!" Q
;
W !!?3,"Setting up database..."
S ^KMPD(8973,"TEST LAB")=1
W "done"
S IEN=$O(^KMPD(8973,0)) Q:'IEN
W !
W !?3,"Updating RUM Weeks to Keep Data = 99 ..."
W !?3," HL7 Weeks to Keep Data = 99 ..."
W !?3," Timing Weeks to Keep Data = 99 ..."
S FDA($J,8973,IEN_",",2.11)=99
S FDA($J,8973,IEN_",",3.11)=99
S FDA($J,8973,IEN_",",4.11)=99
D FILE^DIE("","FDA($J)","ERROR")
I $D(ERROR) D MSG^DIALOG("W","",60,10,"ERROR")
W "done"
W !
W !?3,"Saving ZOSVKRT as %ZOSVKR ..."
D ROUINQ^KMPDU2(.ROUTINE,"ZOSVKRT")
D:$D(ROUTINE) ROUSAVE^KMPDU3(.Z,"%ZOSVKR",.ROUTINE)
W "done"
W !
W !?3,"Deleting old ^KMPTMP(""KMPR"" data..."
K ^KMPTMP("KMPR")
W "done"
S IEN=$O(^DIC(4.2,"B","FO-ALBANY.DOMAIN.EXT",0))
I IEN D
.K FDA,ERROR
.W !!?3,"Setting FLAGS to SEND for domain FO-ALBANY.DOMAIN.EXT..."
.S FDA($J,4.2,IEN_",",1)="S"
.D FILE^DIE("","FDA($J)","ERROR")
.D:$D(ROUTINE) ROUSAVE^KMPDU3(.Z,"%ZOSVKR",.ROUTINE)
.W "done"
;
W !!?3,"*** This is now a Capacity Planning Test Lab database ***"
;
Q
;
TESTLAB() ;-extrinsic - test for test lab database
;-----------------------------------------------------------------------------
; return: "0" - not a test lab database
; "1^TESTLAB-" - it is a test lab database
;-----------------------------------------------------------------------------
N TL
S TL=+$G(^KMPD(8973,"TEST LAB"))
Q $S('TL:0,1:"1^TESTLAB-")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUT1 1962 printed Dec 13, 2024@01:41:10 Page 2
KMPDUT1 ;OAK/RAK - Test Lab Utility ;6/21/05 10:17
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
TL ;-entry point for setting up database as a test lab
+1 ;
+2 ; patch "KMPR*2.0*2" must be installed
+3 IF '$$PATCH^XPDUTL("KMPR*2.0*2")
Begin DoDot:1
+4 WRITE !?3,"Patch 'KMPR*2.0*2' must be installed to run this routine!",!!
End DoDot:1
QUIT
+5 ;
+6 NEW DIR,ERROR,IEN,FDA,ROUTINE,X,Y,Z
+7 SET DIR(0)="YO"
SET DIR("B")="N"
+8 SET DIR("A")="Do you want to set this up as a Test Lab database for Capacity Planning"
+9 WRITE !
DO ^DIR
+10 IF 'Y
WRITE !!?3,$CHAR(7),"No action taken!"
QUIT
+11 ;
+12 WRITE !!?3,"Setting up database..."
+13 SET ^KMPD(8973,"TEST LAB")=1
+14 WRITE "done"
+15 SET IEN=$ORDER(^KMPD(8973,0))
if 'IEN
QUIT
+16 WRITE !
+17 WRITE !?3,"Updating RUM Weeks to Keep Data = 99 ..."
+18 WRITE !?3," HL7 Weeks to Keep Data = 99 ..."
+19 WRITE !?3," Timing Weeks to Keep Data = 99 ..."
+20 SET FDA($JOB,8973,IEN_",",2.11)=99
+21 SET FDA($JOB,8973,IEN_",",3.11)=99
+22 SET FDA($JOB,8973,IEN_",",4.11)=99
+23 DO FILE^DIE("","FDA($J)","ERROR")
+24 IF $DATA(ERROR)
DO MSG^DIALOG("W","",60,10,"ERROR")
+25 WRITE "done"
+26 WRITE !
+27 WRITE !?3,"Saving ZOSVKRT as %ZOSVKR ..."
+28 DO ROUINQ^KMPDU2(.ROUTINE,"ZOSVKRT")
+29 if $DATA(ROUTINE)
DO ROUSAVE^KMPDU3(.Z,"%ZOSVKR",.ROUTINE)
+30 WRITE "done"
+31 WRITE !
+32 WRITE !?3,"Deleting old ^KMPTMP(""KMPR"" data..."
+33 KILL ^KMPTMP("KMPR")
+34 WRITE "done"
+35 SET IEN=$ORDER(^DIC(4.2,"B","FO-ALBANY.DOMAIN.EXT",0))
+36 IF IEN
Begin DoDot:1
+37 KILL FDA,ERROR
+38 WRITE !!?3,"Setting FLAGS to SEND for domain FO-ALBANY.DOMAIN.EXT..."
+39 SET FDA($JOB,4.2,IEN_",",1)="S"
+40 DO FILE^DIE("","FDA($J)","ERROR")
+41 if $DATA(ROUTINE)
DO ROUSAVE^KMPDU3(.Z,"%ZOSVKR",.ROUTINE)
+42 WRITE "done"
End DoDot:1
+43 ;
+44 WRITE !!?3,"*** This is now a Capacity Planning Test Lab database ***"
+45 ;
+46 QUIT
+47 ;
TESTLAB() ;-extrinsic - test for test lab database
+1 ;-----------------------------------------------------------------------------
+2 ; return: "0" - not a test lab database
+3 ; "1^TESTLAB-" - it is a test lab database
+4 ;-----------------------------------------------------------------------------
+5 NEW TL
+6 SET TL=+$GET(^KMPD(8973,"TEST LAB"))
+7 QUIT $SELECT('TL:0,1:"1^TESTLAB-")
