ACHSSIG0.m

ACHSSIG0 ;ITSC/JVK/SET - ADD EDIT CHS AUTHORIZED E-SIG USERS  [ 11/26/2003  11:16 AM ]

 ;;3.1;CONTRACT HEALTH MANAGEMENT SYSTEM;**7**;JUNE 11,2001

 ;ACHS*3.1*7- NEW ROUTINE TO ADD EDIT E-SIG USERS

 ;

USRS ;EP

 D LOC

 W !!!,?5,"Add or Edit entries in the CHS E-Sig Authority File for ",ACHSSITE,".",!

 W ?5,"Users must have a written Delegation of Authority to sign",!?5,"Contract Health Services Purchase Orders.",!

 ;

 N DA,DIC,DIE,DR,DLAYGO

 S DIE="^ACHSESIG("

 S DR=".01;1",DA=DUZ(2)

 D ^DIE

 S DR="1.01:1.5"

 D ^DIE

 Q

SITE ;EP

 D LOC

 W !!!,?5,"Add a site to the CHS E-Sig Authority File."

 N DA,DIC,DIE,DR,DLAYGO

 S DIE="^ACHSESIG("

 I $P(^ACHSESIG(0),U,3)="" S $P(^ACHSESIG(0),U,3)=DUZ(2)

 I $P(^ACHSESIG(0),U,4)="" S $P(^ACHSESIG(0),U,4)=1

 S DR=".01;.02;.03",DA=DUZ(2)

 D ^DIE

 Q

LOC ;

 I '$D(^XUSEC("ACHSZMGR",DUZ)) Q

 S ACHSSITE=$P($G(^DIC(4,DUZ(2),0)),U)

 Q

ACHSSIG0  ;ITSC/JVK/SET - ADD EDIT CHS AUTHORIZED E-SIG USERS  [ 11/26/2003  11:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MANAGEMENT SYSTEM;**7**;JUNE 11,2001

 +2       ;ACHS*3.1*7- NEW ROUTINE TO ADD EDIT E-SIG USERS

 +3       ;

USRS      ;EP

 +1        DO LOC

 +2        WRITE !!!,?5,"Add or Edit entries in the CHS E-Sig Authority File for ",ACHSSITE,".",!

 +3        WRITE ?5,"Users must have a written Delegation of Authority to sign",!?5,"Contract Health Services Purchase Orders.",!

 +4       ;

 +5        NEW DA,DIC,DIE,DR,DLAYGO

 +6        SET DIE="^ACHSESIG("

 +7        SET DR=".01;1"

           SET DA=DUZ(2)

 +8        DO ^DIE

 +9        SET DR="1.01:1.5"

 +10       DO ^DIE

 +11       QUIT 

SITE      ;EP

 +1        DO LOC

 +2        WRITE !!!,?5,"Add a site to the CHS E-Sig Authority File."

 +3        NEW DA,DIC,DIE,DR,DLAYGO

 +4        SET DIE="^ACHSESIG("

 +5        IF $PIECE(^ACHSESIG(0),U,3)=""

               SET $PIECE(^ACHSESIG(0),U,3)=DUZ(2)

 +6        IF $PIECE(^ACHSESIG(0),U,4)=""

               SET $PIECE(^ACHSESIG(0),U,4)=1

 +7        SET DR=".01;.02;.03"

           SET DA=DUZ(2)

 +8        DO ^DIE

 +9        QUIT 

LOC       ;

 +1        IF '$DATA(^XUSEC("ACHSZMGR",DUZ))

               QUIT 

 +2        SET ACHSSITE=$PIECE($GET(^DIC(4,DUZ(2),0)),U)

 +3        QUIT