ACMSUSR.m

ACMSUSR ; IHS/TUCSON/TMJ - USER AUTHORIZATION...ALL REGISTERS ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 ;

 S DIC="^VA(200,",DIC(0)="AQEM" D ^DIC Q:+Y<1

 S ACMX=0,ACMY=+Y F  S ACMX=$O(^ACM(41.1,ACMX)) Q:+ACMX=0  D ONE

 W !,"User is now authorized for ALL registers...",!!

 Q

ONE ;

 I '$D(^ACM(41.1,ACMX,"AU",0)) S ^ACM(41.1,ACMX,"UA",0)="^9002241.12P^0^0"

 S DIE="^ACM(41.1,ACMX,""AU"",",DA(1)=ACMX,DA=ACMY,DR=".01///^S X=DA",DIC(0)="LX" D ^DIE  Q

ACMSUSR   ; IHS/TUCSON/TMJ - USER AUTHORIZATION...ALL REGISTERS ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 +2       ;

 +3        SET DIC="^VA(200,"

           SET DIC(0)="AQEM"

           DO ^DIC

           IF +Y<1

               QUIT 

 +4        SET ACMX=0

           SET ACMY=+Y

           FOR 

               SET ACMX=$ORDER(^ACM(41.1,ACMX))

               IF +ACMX=0

                   QUIT 

               DO ONE

 +5        WRITE !,"User is now authorized for ALL registers...",!!

 +6        QUIT 

ONE       ;

 +1        IF '$DATA(^ACM(41.1,ACMX,"AU",0))

               SET ^ACM(41.1,ACMX,"UA",0)="^9002241.12P^0^0"

 +2        SET DIE="^ACM(41.1,ACMX,""AU"","

           SET DA(1)=ACMX

           SET DA=ACMY

           SET DR=".01///^S X=DA"

           SET DIC(0)="LX"

           DO ^DIE

           QUIT