- 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 ---[H[J[2J[HPSOSUP 1622 printed Mar 13, 2025@21:40:26 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
