BLRMPRL.m

BLRMPRL ; cmi/anch/maw - BLR Map Reference Lab Codes to Lab Test File ;

 ;;5.2;LR;**1021,1022**;September 20, 2007

 ;;

 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005

 ;

 ;this routine will allow a user to map reference lab tests to file

 ;60 lab tests

 ;

MAIN ;PEP - main routine driver

 D ASK

 Q:+$G(Y)<0  ; cmi/anch/maw 7/10/2006 mod for error reported by KM -- Lab Patch 1022

 D ORR(BLRRL)

 D EOJ

 Q

 ;

ASK ;-- ask which reference lab to map

 S DIC="^BLRRL(",DIC(0)="AEMQZ"

 S DIC("A")="Select Which Reference Lab to Map Codes for: "

 D ^DIC

 Q:Y<0

 S BLRRL=+Y

 K DIC

 Q

 ;

ORR(RL) ;EP - ask and map for reference lab test

OR S DIC="^BLRRL("_BLRRL_",1,",DA(1)=RL,DIC(0)="AELMQZ"

 S DIC("A")="Map which Reference Lab Test: "

 D ^DIC

 S BLROR=+Y

 Q:Y<0

 S DIE=DIC,DA=BLROR,DR=".01:10"  ;added edit of .01 at DKR request 2/3/2006 3/24/2006 added field 10

 D ^DIE

 G OR

 ;

EOJ ;-- kill variables and quit

 K BLRRL,RL,DIC,DIE,DR,BLROR

 Q

 ;

BLRMPRL   ; cmi/anch/maw - BLR Map Reference Lab Codes to Lab Test File ;

 +1       ;;5.2;LR;**1021,1022**;September 20, 2007

 +2       ;;

 +3       ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005

 +4       ;

 +5       ;this routine will allow a user to map reference lab tests to file

 +6       ;60 lab tests

 +7       ;

MAIN      ;PEP - main routine driver

 +1        DO ASK

 +2       ; cmi/anch/maw 7/10/2006 mod for error reported by KM -- Lab Patch 1022

           IF +$GET(Y)<0

               QUIT 

 +3        DO ORR(BLRRL)

 +4        DO EOJ

 +5        QUIT 

 +6       ;

ASK       ;-- ask which reference lab to map

 +1        SET DIC="^BLRRL("

           SET DIC(0)="AEMQZ"

 +2        SET DIC("A")="Select Which Reference Lab to Map Codes for: "

 +3        DO ^DIC

 +4        IF Y<0

               QUIT 

 +5        SET BLRRL=+Y

 +6        KILL DIC

 +7        QUIT 

 +8       ;

ORR(RL)   ;EP - ask and map for reference lab test

OR         SET DIC="^BLRRL("_BLRRL_",1,"

           SET DA(1)=RL

           SET DIC(0)="AELMQZ"

 +1        SET DIC("A")="Map which Reference Lab Test: "

 +2        DO ^DIC

 +3        SET BLROR=+Y

 +4        IF Y<0

               QUIT 

 +5       ;added edit of .01 at DKR request 2/3/2006 3/24/2006 added field 10

           SET DIE=DIC

           SET DA=BLROR

           SET DR=".01:10"

 +6        DO ^DIE

 +7        GOTO OR

 +8       ;

EOJ       ;-- kill variables and quit

 +1        KILL BLRRL,RL,DIC,DIE,DR,BLROR

 +2        QUIT 

 +3       ;