PSOSUP ;BHAM ISC/SAB-ENTER PHARMACISTS ; 07/13/92 16:43
;;7.0;OUTPATIENT PHARMACY;**10,268,501,770**;DEC 1997;Build 145
N DIC,X,Y,DR,PSN,DIE,KEY,PHARM,A,H,J,C,G,PSOSCRY,PSOFIRST,PSOSTOP,Z
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)
K DIC 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
;
W ! K DIC S DIC(0)="AEMQ",DIC=19.1 ;,DIC("B")="PSORPH"
S DIC("S")="I "",PSORPH,PSO ERX WORKLOAD TECH,PSO ERX WORKLOAD RPH,""[("",""_X_"","")"
D ^DIC I $G(Y)'>0 D EX G ASK
S KEY=X
;
I PSN>0 S DA=+PSN,DIE=200,DR="51///"_KEY,DR(51,200.051)=".01///"_KEY_";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(KEY,PSN))) W !,$P(^VA(200,PSN,0),"^")_" DOES NOT hold the '"_KEY_"' Security Key",! D EX G ASK
W !,$P(^VA(200,PSN,0),"^")_" now holds the '"_KEY_"' 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,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 ---[H[J[2J[HPSOSUP 1902 printed Sep 23, 2025@20:11:58 Page 2
PSOSUP ;BHAM ISC/SAB-ENTER PHARMACISTS ; 07/13/92 16:43
+1 ;;7.0;OUTPATIENT PHARMACY;**10,268,501,770**;DEC 1997;Build 145
+2 NEW DIC,X,Y,DR,PSN,DIE,KEY,PHARM,A,H,J,C,G,PSOSCRY,PSOFIRST,PSOSTOP,Z
+3 DO EX
+4 WRITE @IOF
+5 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 KILL DIC
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
+5 ;
+6 ;,DIC("B")="PSORPH"
WRITE !
KILL DIC
SET DIC(0)="AEMQ"
SET DIC=19.1
+7 SET DIC("S")="I "",PSORPH,PSO ERX WORKLOAD TECH,PSO ERX WORKLOAD RPH,""[("",""_X_"","")"
+8 DO ^DIC
IF $GET(Y)'>0
DO EX
GOTO ASK
+9 SET KEY=X
+10 ;
+11 IF PSN>0
SET DA=+PSN
SET DIE=200
SET DR="51///"_KEY
SET DR(51,200.051)=".01///"_KEY_";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)
+12 IF $DATA(Y)!('$DATA(^XUSEC(KEY,PSN)))
WRITE !,$PIECE(^VA(200,PSN,0),"^")_" DOES NOT hold the '"_KEY_"' Security Key",!
DO EX
GOTO ASK
+13 WRITE !,$PIECE(^VA(200,PSN,0),"^")_" now holds the '"_KEY_"' 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,PSOSTOP
+1 QUIT
+2 ;
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
