KMPDUT1.m

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 ---KMPDUT1   1962     printed  Feb 18, 2025@23:07:33                                                                                                                                                                                                     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-")