ABMRLABS.m

ABMRLABS ; IHS/SD/SDR - Add/Edit Reference Lab Locations - 3/15/2005 2:11:05 PM

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ; New routine - 3/15/05

 ;

EP ;

 K DIC

 S DIC="^ABMRLABS("

 S DIC(0)="QAELM"

 D ^DIC

 Q:(+Y<0)

 I $P(Y,"^",3)'=1 D  ;not new entry; prompt for .02

 .S DIE=DIC

 .S DA=+Y

 .S DR=".01//;.02//"

 .D ^DIE

 Q

ABMRLABS  ; IHS/SD/SDR - Add/Edit Reference Lab Locations - 3/15/2005 2:11:05 PM

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ; New routine - 3/15/05

 +3       ;

EP        ;

 +1        KILL DIC

 +2        SET DIC="^ABMRLABS("

 +3        SET DIC(0)="QAELM"

 +4        DO ^DIC

 +5        IF (+Y<0)

               QUIT 

 +6       ;not new entry; prompt for .02

           IF $PIECE(Y,"^",3)'=1

               Begin DoDot:1

 +7                SET DIE=DIC

 +8                SET DA=+Y

 +9                SET DR=".01//;.02//"

 +10               DO ^DIE

               End DoDot:1

 +11       QUIT