ACHSTV.m

ACHSTV ; IHS/ITSC/PMF - test version of routines  [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

        ;;3.1T1;ACHS;;JAN 19, 2001 

 ;

 ; this routine allows the user to turn test versions off

 ;and on.  The routine must first already be defined in

 ;               ^ACHS("TEST VERSION").    Example

 ;

 ;     ^ACHS("TEST VERSION",4)="ACHSFOO^ACHSFOOX^0"

 ;

 ;If it is defined there, the user can set or clear the flag

 ;that says "YES, USE THE TEST VERSION"

 ;

 ;

 N DIR

 ;

 ;first ask which routine

 S DIR(0)="FO^3:32^I '$D(^ACHS(""TEST VERSION"",""B"",X)) K X"

 S DIR("A")="Enter the routine name for testing "

 S DIR("?")="Enter ?? for a list of valid testing routines"

 S DIR("??")="^D LIST^ACHSTV"

 W !! D ^DIR

 I Y=""!(Y["^") Q

 ;

 S ACHSNUM=$O(^ACHS("TEST VERSION","B",Y,""))

 I ACHSNUM="" W !!,"Entry not found.  Please report this to the Support Team" Q

 ;

 S ACHSON=$P($G(^ACHS("TEST VERSION",ACHSNUM,1)),U,3)

 S DIR(0)="SOMB^Y:Yes;N:No"

 I ACHSON S DIR("A")="Test version in use. "

 I 'ACHSON S DIR("A")="Test version NOT in use. "

 S DIR("A")=DIR("A")_"Change? "

 W !! D ^DIR

 ;

 I Y=""!(Y="N") W !!,"No action taken   ",!! D RTRN^ACHS Q

 S $P(^ACHS("TEST VERSION",ACHSNUM,1),U,3)='ACHSON

 W !!,"Change made   ",!! D RTRN^ACHS

 Q

LIST ;

 W !!,"These routines are presently on the test list",!

 S ACHSA="" F  S ACHSA=$O(^ACHS("TEST VERSION","B",ACHSA)) Q:ACHSA=""  W !,?5,ACHSA

 W !

 Q

ACHSTV    ; IHS/ITSC/PMF - test version of routines  [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;;3.1T1;ACHS;;JAN 19, 2001 

 +3       ;

 +4       ; this routine allows the user to turn test versions off

 +5       ;and on.  The routine must first already be defined in

 +6       ;               ^ACHS("TEST VERSION").    Example

 +7       ;

 +8       ;     ^ACHS("TEST VERSION",4)="ACHSFOO^ACHSFOOX^0"

 +9       ;

 +10      ;If it is defined there, the user can set or clear the flag

 +11      ;that says "YES, USE THE TEST VERSION"

 +12      ;

 +13      ;

 +14       NEW DIR

 +15      ;

 +16      ;first ask which routine

 +17       SET DIR(0)="FO^3:32^I '$D(^ACHS(""TEST VERSION"",""B"",X)) K X"

 +18       SET DIR("A")="Enter the routine name for testing "

 +19       SET DIR("?")="Enter ?? for a list of valid testing routines"

 +20       SET DIR("??")="^D LIST^ACHSTV"

 +21       WRITE !!

           DO ^DIR

 +22       IF Y=""!(Y["^")

               QUIT 

 +23      ;

 +24       SET ACHSNUM=$ORDER(^ACHS("TEST VERSION","B",Y,""))

 +25       IF ACHSNUM=""

               WRITE !!,"Entry not found.  Please report this to the Support Team"

               QUIT 

 +26      ;

 +27       SET ACHSON=$PIECE($GET(^ACHS("TEST VERSION",ACHSNUM,1)),U,3)

 +28       SET DIR(0)="SOMB^Y:Yes;N:No"

 +29       IF ACHSON

               SET DIR("A")="Test version in use. "

 +30       IF 'ACHSON

               SET DIR("A")="Test version NOT in use. "

 +31       SET DIR("A")=DIR("A")_"Change? "

 +32       WRITE !!

           DO ^DIR

 +33      ;

 +34       IF Y=""!(Y="N")

               WRITE !!,"No action taken   ",!!

               DO RTRN^ACHS

               QUIT 

 +35       SET $PIECE(^ACHS("TEST VERSION",ACHSNUM,1),U,3)='ACHSON

 +36       WRITE !!,"Change made   ",!!

           DO RTRN^ACHS

 +37       QUIT 

LIST      ;

 +1        WRITE !!,"These routines are presently on the test list",!

 +2        SET ACHSA=""

           FOR 

               SET ACHSA=$ORDER(^ACHS("TEST VERSION","B",ACHSA))

               IF ACHSA=""

                   QUIT 

               WRITE !,?5,ACHSA

 +3        WRITE !

 +4        QUIT