PSOSUP.m

PSOSUP ;BHAM ISC/SAB-ENTER PHARMACISTS ; 07/13/92 16:43

 ;;7.0;OUTPATIENT PHARMACY;**10,268,501**;DEC 1997;Build 8

 D EX

 W @IOF

 I DUZ(0)'="@",'$D(^XUSEC("XUMGR",DUZ)),'$D(^XUSEC("PSORPH",DUZ)) W !,$C(7),"You Must Hold the 'PSORPH' key in order to be able to use this option!",! G EX

ASK R !!,"Select PHARMACIST: ",X:DTIME I '$T!(X="") S X="^"

 G:X["^" EX D PHASK:X["?" G PSOSUP:$G(PSOSTOP)

 S DIC=200,DIC(0)="EQMZ" D ^DIC

 G PSOSUP:X["?"!(Y<0) S PHARM=$P(Y(0),"^"),PSN=+Y

 S DA=PSN,DIC(0)="EQMZ",(DIE,DIC)=200 D ^DIC I Y>0 S DA=+Y,DIE=DIC,DR="51///PSORPH",DR(51,200.051)=".01///PSORPH;1////"_$S($G(DUZ):DUZ,1:"")_";2///"_DT L +^VA(200,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) D ^DIE L -^VA(200,DA)

 I $D(Y)!('$D(^XUSEC("PSORPH",PSN))) W !,$P(^VA(200,PSN,0),"^")_" DOES NOT hold the 'PSORPH' Security Key",! D EX G ASK

 W !,$P(^VA(200,PSN,0),"^")_" now holds the 'PSORPH' Security Key",! G ASK

EX K %,X,Y,%Y,C,D0,D1,DA,DI,DIE,DIQ,DIH,DIU,DIV,DLAYGO,DQ,DR,I,PSN,PHARM,Z,DIC,DIG,PSOSTOP

 Q

PHASK W !,"The pharmacist is an entry in the NEW PERSON file and holds the PSORPH",!,"key in the SECURITY KEY file.",!,"To delete a pharmacist, enter the name at the Select Pharmacist prompt and"

 W !,"when the key PSORPH is shown as a default enter @ press return.",!,"The current list of PSORPH holders are:"

 S A="",C=0,G=18,PSOFIRST=1

 F J=0:0 S J=$O(^XUSEC("PSORPH",J)) Q:'J!($G(PSOSTOP))  W !?5,$P($G(^VA(200,J,0)),"^") S PSOSCRY=$G(PSOSCRY)+1 I $S(PSOFIRST:PSOSCRY+7>IOSL,1:PSOSCRY+2>IOSL) D

 .R !,"Enter '^' to stop",A:DTIME S:A["^" PSOSTOP=1 S PSOSCRY=1,PSOFIRST=0

 K A,H,J,PSOSCRY,PSOFIRST Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOSUP   1622     printed  Apr 09, 2024@21:32:38                                                                                                                                                                                                      Page 2

PSOSUP    ;BHAM ISC/SAB-ENTER PHARMACISTS ; 07/13/92 16:43

 +1       ;;7.0;OUTPATIENT PHARMACY;**10,268,501**;DEC 1997;Build 8

 +2        DO EX

 +3        WRITE @IOF

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

               IF '$DATA(^XUSEC("XUMGR",DUZ))

                   IF '$DATA(^XUSEC("PSORPH",DUZ))

                       WRITE !,$CHAR(7),"You Must Hold the 'PSORPH' key in order to be able to use this option!",!

                       GOTO EX

ASK        READ !!,"Select PHARMACIST: ",X:DTIME

           IF '$TEST!(X="")

               SET X="^"

 +1        if X["^"

               GOTO EX

           if X["?"

               DO PHASK

           if $GET(PSOSTOP)

               GOTO PSOSUP

 +2        SET DIC=200

           SET DIC(0)="EQMZ"

           DO ^DIC

 +3        if X["?"!(Y<0)

               GOTO PSOSUP

           SET PHARM=$PIECE(Y(0),"^")

           SET PSN=+Y

 +4        SET DA=PSN

           SET DIC(0)="EQMZ"

           SET (DIE,DIC)=200

           DO ^DIC

           IF Y>0

               SET DA=+Y

               SET DIE=DIC

               SET DR="51///PSORPH"

               SET DR(51,200.051)=".01///PSORPH;1////"_$SELECT($GET(DUZ):DUZ,1:"")_";2///"_DT

               LOCK +^VA(200,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)

               DO ^DIE

               LOCK -^VA(200,DA)

 +5        IF $DATA(Y)!('$DATA(^XUSEC("PSORPH",PSN)))

               WRITE !,$PIECE(^VA(200,PSN,0),"^")_" DOES NOT hold the 'PSORPH' Security Key",!

               DO EX

               GOTO ASK

 +6        WRITE !,$PIECE(^VA(200,PSN,0),"^")_" now holds the 'PSORPH' Security Key",!

           GOTO ASK

EX         KILL %,X,Y,%Y,C,D0,D1,DA,DI,DIE,DIQ,DIH,DIU,DIV,DLAYGO,DQ,DR,I,PSN,PHARM,Z,DIC,DIG,PSOSTOP

 +1        QUIT 

PHASK      WRITE !,"The pharmacist is an entry in the NEW PERSON file and holds the PSORPH",!,"key in the SECURITY KEY file.",!,"To delete a pharmacist, enter the name at the Select Pharmacist prompt and"

 +1        WRITE !,"when the key PSORPH is shown as a default enter @ press return.",!,"The current list of PSORPH holders are:"

 +2        SET A=""

           SET C=0

           SET G=18

           SET PSOFIRST=1

 +3        FOR J=0:0

               SET J=$ORDER(^XUSEC("PSORPH",J))

               if 'J!($GET(PSOSTOP))

                   QUIT 

               WRITE !?5,$PIECE($GET(^VA(200,J,0)),"^")

               SET PSOSCRY=$GET(PSOSCRY)+1

               IF $SELECT(PSOFIRST:PSOSCRY+7>IOSL,1:PSOSCRY+2>IOSL)

                   Begin DoDot:1

 +4                    READ !,"Enter '^' to stop",A:DTIME

                       if A["^"

                           SET PSOSTOP=1

                       SET PSOSCRY=1

                       SET PSOFIRST=0

                   End DoDot:1

 +5        KILL A,H,J,PSOSCRY,PSOFIRST

           QUIT