AQAQ.m

AQAQ ;IHS/ASU/RPL;CREDENTIALS FILE INITIALIZE VARIABLES ; 11/28/89  8:06 AM

 ;;STAFF CREDENTIALS Version 1.1;11/7/89

 ;Called from Menu Entrance of Option AQAQCREDMENU

 ;

 S Y="",Y=$O(^DIC(9.4,"C","AQAQ",Y)),AQAQ("VERSION")=^DIC(9.4,Y,"VERSION"),Y=$P(^DIC(9.4,Y,22,AQAQ("VERSION"),0),"^",2) X ^DD("DD") S AQAQ("VERDT")=Y

 D ^%AUCLS W !?22 F AQAQ("I")=1:1:35 W "*"

 W !?22,"*",?56,"*",!?22,"*      INDIAN HEALTH SERVICE      *",!

 W ?22,"*    MEDICAL STAFF CREDENTIALS    *",!?22,"*     VERSION ",AQAQ("VERSION"),", ",AQAQ("VERDT"),?56,"*",!?22,"*",?56,"*",!?22 F AQAQ("I")=1:1:35 W "*"

 I '$D(DUZ(2))!('$D(DUZ(0))) W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE STAFF CREDENTIALS!" S XQUIT=1 G XQUIT

 S X=$S($D(^DIC(4,DUZ(2),0))#2:$P(^(0),"^"),1:"") W !!,?80-$L(X)\2,X

 I X="" W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!" S XQUIT="" G XQUIT

 I DUZ(0)'="@" S AQAQDUZ0=DUZ(0),DUZ(0)="q"_DUZ(0)

XQUIT W ! K AQAQ

 Q

XIT ;Called from Menu Exit of Option AQAQCREDMENU

 I DUZ(0)'="@" S DUZ(0)=AQAQDUZ0 K AQAQDUZ0

 Q

AQAQ      ;IHS/ASU/RPL;CREDENTIALS FILE INITIALIZE VARIABLES ; 11/28/89  8:06 AM

 +1       ;;STAFF CREDENTIALS Version 1.1;11/7/89

 +2       ;Called from Menu Entrance of Option AQAQCREDMENU

 +3       ;

 +4        SET Y=""

           SET Y=$ORDER(^DIC(9.4,"C","AQAQ",Y))

           SET AQAQ("VERSION")=^DIC(9.4,Y,"VERSION")

           SET Y=$PIECE(^DIC(9.4,Y,22,AQAQ("VERSION"),0),"^",2)

           XECUTE ^DD("DD")

           SET AQAQ("VERDT")=Y

 +5        DO ^%AUCLS

           WRITE !?22

           FOR AQAQ("I")=1:1:35

               WRITE "*"

 +6        WRITE !?22,"*",?56,"*",!?22,"*      INDIAN HEALTH SERVICE      *",!

 +7        WRITE ?22,"*    MEDICAL STAFF CREDENTIALS    *",!?22,"*     VERSION ",AQAQ("VERSION"),", ",AQAQ("VERDT"),?56,"*",!?22,"*",?56,"*",!?22

           FOR AQAQ("I")=1:1:35

               WRITE "*"

 +8        IF '$DATA(DUZ(2))!('$DATA(DUZ(0)))

               WRITE !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE STAFF CREDENTIALS!"

               SET XQUIT=1

               GOTO XQUIT

 +9        SET X=$SELECT($DATA(^DIC(4,DUZ(2),0))#2:$PIECE(^(0),"^"),1:"")

           WRITE !!,?80-$LENGTH(X)\2,X

 +10       IF X=""

               WRITE !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"

               SET XQUIT=""

               GOTO XQUIT

 +11       IF DUZ(0)'="@"

               SET AQAQDUZ0=DUZ(0)

               SET DUZ(0)="q"_DUZ(0)

XQUIT      WRITE !

           KILL AQAQ

 +1        QUIT 

XIT       ;Called from Menu Exit of Option AQAQCREDMENU

 +1        IF DUZ(0)'="@"

               SET DUZ(0)=AQAQDUZ0

               KILL AQAQDUZ0

 +2        QUIT