AQAC.m

AQAC ;IHS/ASU/RPL ;QA/UR VARIABLES SETUP ; 11/8/89  11:24 AM

 ;;QA/UR Version 2.04;11/7/89

 ;Called from Menu Entrance of Option AQACMENU

 ;

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

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

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

 W ?14,"*  QUALITY ASSURANCE / UTILIZATION REVIEW SYSTEM",?64,"*",!,?14,"*",?64,"*",!,?14,"*********     VERSION ",AQAC("VERSION"),", ",AQAC("VERDT"),?56,"*********",!?22,"*",?56,"*",!?22 F AQAC("I")=1:1:35 W "*"

 I '$D(DUZ(2))!('$D(DUZ(0))) W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE QA/UR!" 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

 S AQACSITE=$S($D(^AUTTSITE(1,0)):$P(^(0),"^"),1:"")

 I AQACSITE="" W *7,!!,"RPMS SITE IS NOT DEFINED",!,"NOTIFY YOUR SITE MANAGER" S XQUIT=1 G XQUIT

 I DUZ(2)'=AQACSITE W *7,!!,"YOU ARE NOT SET TO THE RPMS SITE",!,"NOTIFY YOUR SITE MANAGER" S XQUIT=1 G XQUIT

 I DUZ(0)'="@" S AQACDUZ0=DUZ(0),DUZ(0)="Q"_DUZ(0)

XQUIT W ! K AQAC,AQACSITE

 Q

XIT ;Called from Menu Exit of Option AQACMENU

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

 Q

AQAC      ;IHS/ASU/RPL ;QA/UR VARIABLES SETUP ; 11/8/89  11:24 AM

 +1       ;;QA/UR Version 2.04;11/7/89

 +2       ;Called from Menu Entrance of Option AQACMENU

 +3       ;

 +4        SET Y=""

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

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

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

           XECUTE ^DD("DD")

           SET AQAC("VERDT")=Y

 +5        DO ^%AUCLS

           WRITE !?22

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

               WRITE "*"

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

 +7        WRITE ?14,"*  QUALITY ASSURANCE / UTILIZATION REVIEW SYSTEM",?64,"*",!,?14,"*",?64,"*",!,?14,"*********     VERSION ",AQAC("VERSION"),", ",AQAC("VERDT"),?56,"*********",!?22,"*",?56,"*",!?22

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

               WRITE "*"

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

               WRITE !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE QA/UR!"

               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       SET AQACSITE=$SELECT($DATA(^AUTTSITE(1,0)):$PIECE(^(0),"^"),1:"")

 +12       IF AQACSITE=""

               WRITE *7,!!,"RPMS SITE IS NOT DEFINED",!,"NOTIFY YOUR SITE MANAGER"

               SET XQUIT=1

               GOTO XQUIT

 +13       IF DUZ(2)'=AQACSITE

               WRITE *7,!!,"YOU ARE NOT SET TO THE RPMS SITE",!,"NOTIFY YOUR SITE MANAGER"

               SET XQUIT=1

               GOTO XQUIT

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

               SET AQACDUZ0=DUZ(0)

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

XQUIT      WRITE !

           KILL AQAC,AQACSITE

 +1        QUIT 

XIT       ;Called from Menu Exit of Option AQACMENU

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

               SET DUZ(0)=AQACDUZ0

               KILL AQACDUZ0

 +2        QUIT