PSSPOIM2 ;BIR/RTR/WRT-Orderable Item manual create - initial create ; 09/01/98 7:12
;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
D WOOPS H 2 Q:$D(^TMP("PSSLOOP"))
S PSSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSITE,80)),"^",2)'=2 W !!?3,$S($P($G(^(80)),"^",2)<2:"Orderable Item Auto-Create has not been completed!",1:"Manual matching process complete!"),!! K PSSITE D Q
.K DIR S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
S PSOUT=0 D MESSZ^PSSPOIM1 G:$G(PSOUT) CHECK
S PSCREATE=1 D ^PSSPOIM3 G:$G(PSOOOUT) CHECK
BEG ;
W !!?3,"NOW MATCHING DISPENSE DRUGS!",!
S X1=DT,X2=-365 D C^%DTC S PSXDATE=X,PSOUT=0,AAA=""
F S AAA=$O(^PSDRUG("B",AAA)) Q:AAA=""!($G(PSOUT)) F PSIEN=0:0 S PSIEN=$O(^PSDRUG("B",AAA,PSIEN)) Q:'PSIEN!($G(PSOUT)) I $G(PSIEN),'$P($G(^PSDRUG(PSIEN,2)),"^") D I ZXX I APLU["I"!(APLU["O")!(APLU["U") S PSNAME=$P(^(0),"^") D START
.S APLU=$P($G(^PSDRUG(PSIEN,2)),"^",3)
.S ZXX=1 S PSXDDATE=+$P($G(^PSDRUG(PSIEN,"I")),"^") I PSXDDATE,PSXDDATE<PSXDATE S ZXX=0
CHECK D CHECK^PSSPOIM1
G END^PSSPOIM1
START K DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,RESTART W !!!?5,"Dispense Drug -> ",PSNAME
S NODE=$G(^PSDRUG(PSIEN,"ND")),DOSEPTR=0,DA=$P($G(NODE),"^"),X=$$VAGN^PSNAPIS(DA),VAGEN=X I +$P(NODE,"^"),+$P(NODE,"^",3),$G(VAGEN)'=0 S K=$P($G(NODE),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSEFV=X I $G(DOSEFV)'=0 D
.S DOSEPTR=$P(X,"^"),DOSEFORM=$P(X,"^",2)
K PSPOI D TMP
D MCH D:$G(PSPOI) I $G(PSOUT) W ! S PSOUT=0,RESTART=1 K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to exit this option" D ^DIR K DIR I Y!(Y["^")!($D(DTOUT)) S PSOUT=1
.S NEWFLAG=1 D DIR^PSSPOIM3 I $G(PSSDIR) W !!?3,"Now editing Orderable Item:",!?3,$P($G(^PS(50.7,PSPOI,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^") D INACT^PSSADDIT
.K NEWFLAG,PSSDIR D EN^PSSPOIDT(PSPOI) K PSPOI
I $G(RESTART),'$G(PSOUT) G START
Q
TMP K ^TMP($J,"PSSOO") S PSCNT=0 I +$P(NODE,"^"),+$P(NODE,"^",3) F ZZ=0:0 S ZZ=$O(^PSDRUG("AND",+NODE,ZZ)) Q:'ZZ I +$P($G(^PSDRUG(ZZ,2)),"^"),$P(^PSDRUG(ZZ,2),"^")'=$G(POINT),$D(^PS(50.7,$P(^PSDRUG(ZZ,2),"^"),0)) S OTH=$G(^PSDRUG(ZZ,"ND")) D
.I +$P(OTH,"^"),+$P(OTH,"^",3),$G(DOSEFV)'=0 S DA=$P($G(OTH),"^"),K=$P($G(OTH),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSA=X I $G(DOSA)'=0,DOSEFV=DOSA D
..S NOFLAG=0,TMPTR=$P(^PSDRUG(ZZ,2),"^") F FFF=0:0 S FFF=$O(^TMP($J,"PSSOO",FFF)) Q:'FFF I $P(^TMP($J,"PSSOO",FFF),"^")=TMPTR S NOFLAG=1
..I 'NOFLAG S PSCNT=PSCNT+1 S ^TMP($J,"PSSOO",PSCNT)=$P(^PSDRUG(ZZ,2),"^")_"^"_ZZ
Q
DISP S MATCH=0 F TT=0:0 S TT=$O(^TMP($J,"PSSOO",TT)) Q:'TT S SPT=$P(^TMP($J,"PSSOO",TT),"^") W !,TT," ",$P($G(^PS(50.7,SPT,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^") I $Y+5>IOSL D Q:Y=0 I Y="" S PSOUT=1 Q
.W ! K DIR S DIR(0)="E" D ^DIR I Y W @IOF W !,?3,"Dispense Drug -> ",PSNAME,!
DISPO Q:$G(PSOUT) W ! K DIR S DIR(0)="N",DIR("A")="Choose number of Orderable Item to match, or '^' to enter a new one" D ^DIR K DIR I Y=""!($D(DTOUT)) S PSOUT=1 Q
Q:Y["^" I '$D(^TMP($J,"PSSOO",+Y)) W !!,?5,"INVALID NUMBER" G DISPO
S MATCH=$P(^TMP($J,"PSSOO",+Y),"^") Q
S PSOUT=1 Q
MCH I $O(^TMP($J,"PSSOO",0)) W ! K DIR S DIR(0)="E" D ^DIR I 'Y!($D(DTOUT)) S PSOUT=1 Q
I $O(^TMP($J,"PSSOO",0)) D OTHER,DISP
Q:$G(PSOUT) I $O(^TMP($J,"PSSOO",0)),$G(MATCH) S PSSP=MATCH D ^PSSPOIM1 I PSOUT!(PSNO) S PSOUT=1 Q
I $O(^TMP($J,"PSSOO",0)),$G(MATCH) K DIE S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_MATCH D ^DIE S PSPOI=MATCH D COM Q
MCHA W ! I $G(DOSEFORM)'="" W !?3,"Dose Form -> ",DOSEFORM,!! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Match to another Orderable Item with same Dose Form" D ^DIR G:Y=1 LOOK I Y["^"!(Y="")!($D(DTOUT)) S PSOUT=1 Q
I $G(DOSEFORM)="" K DIC S DIC="^PS(50.606,",DIC(0)="QEAMZ",DIC("A")="Choose Dose Form: " D ^DIC I $D(DTOUT)!($D(DUOUT))!(Y<1) S PSOUT=1 Q
I $G(DOSEFORM)="" S DOSEPTR=+Y W !!?3,"Dose Form -> ",$G(Y(0,0))
I $G(DOSEFORM)="" K DIR W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Match to another Orderable Item with same Dose Form" D ^DIR
I $G(DOSEFORM)="" S DOSEFORM=$P(^PS(50.606,DOSEPTR,0),"^") G:Y>0 LOOK I $D(DTOUT)!($D(DUOUT))!(Y<0) S PSOUT=1 Q
MCHAN W !! I $L(VAGEN)>40 W !,"VA Generic Name -> ",VAGEN,!
W !,?3,"Dose Form -> ",DOSEFORM,!,?3,"Dispense Drug -> ",PSNAME,!
K DIR S DIR(0)="F^3:40",DIR("A")="Orderable Item Name" S:$L(VAGEN)>2&($L(VAGEN)<41) DIR("B")=VAGEN
D ^DIR I $D(DUOUT)!($D(DTOUT))!(Y["^")!(Y="") S PSOUT=1 Q
I X[""""!($A(X)=45)!('(X'?1P.E))!(X?2"z".E) W $C(7),!!?5,"??" G MCHAN
S X=Y,SPHOLD=X,(STOP,PSNO)=0 F COMM=0:0 S COMM=$O(^PS(50.7,"ADF",SPHOLD,DOSEPTR,COMM)) Q:'COMM!(STOP)!($G(PSOUT)) I COMM,$P($G(^PS(50.7,COMM,0)),"^",3)="" D
.S PSSP=COMM D ^PSSPOIM1 S:PSNO STOP=1 Q:PSOUT!(STOP) K DIE S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_COMM D ^DIE S PSPOI=COMM D COM S STOP=1 Q
Q:PSOUT
I STOP,$G(PSNO) G MCHAN
Q:STOP
S PSMAN=1 D ^PSSPOIM1 G:PSNO MCHAN Q:PSOUT K DIC S DIC="^PS(50.7,",DIC(0)="L",X=SPHOLD,DIC("DR")=".02////"_DOSEPTR K DD,DO D FILE^DICN D:Y<1 G:(Y<1) MCHAN S NEWSP=+Y,DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_NEWSP D ^DIE D COM Q
.W $C(7),!?5,"Unable to create entry, try again!",!! Q
Q
LOOK W !!!?3,"Enter ?? for Pharmacy Orderable Item List!"
W ! K DIC S DIC="^PS(50.7,",DIC(0)="QEAM",DIC("S")="I $P($G(^(0)),""^"",2)=DOSEPTR,$P($G(^(0)),""^"",3)=""""" D ^DIC I Y>0 K DIC("S") S (NEWSP,PSSP)=+Y D ^PSSPOIM1 G:PSNO LOOK Q:PSOUT S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_NEWSP D ^DIE D COM Q
W ! K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Create a new Orderable Item to match" D ^DIR I Y=1 G MCHAN
S PSOUT=1 Q
COM W !,"Match Complete!",! S:'$G(PSPOI) PSPOI=$G(NEWSP) Q
OTHER W @IOF W !,"There are other Dispense Drugs with the same VA Generic Name and same Dose",!,"Form already matched to orderable items. Choose a number to match, or enter",!,"'^' to enter a new one.",!!?6,"Disp. drug -> ",PSNAME,! Q
WOOPS W:$D(^TMP("PSSLOOP")) !!,$C(7),"Sorry, but someone else is using this option.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPOIM2 5908 printed Apr 09, 2024@21:35:26 Page 2
PSSPOIM2 ;BIR/RTR/WRT-Orderable Item manual create - initial create ; 09/01/98 7:12
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
+2 DO WOOPS
HANG 2
if $DATA(^TMP("PSSLOOP"))
QUIT
+3 SET PSSITE=+$ORDER(^PS(59.7,0))
IF $PIECE($GET(^PS(59.7,PSSITE,80)),"^",2)'=2
WRITE !!?3,$SELECT($PIECE($GET(^(80)),"^",2)<2:"Orderable Item Auto-Create has not been completed!",1:"Manual matching process complete!"),!!
KILL PSSITE
Begin DoDot:1
+4 KILL DIR
SET DIR("A")="Press RETURN to continue"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+5 SET PSOUT=0
DO MESSZ^PSSPOIM1
if $GET(PSOUT)
GOTO CHECK
+6 SET PSCREATE=1
DO ^PSSPOIM3
if $GET(PSOOOUT)
GOTO CHECK
BEG ;
+1 WRITE !!?3,"NOW MATCHING DISPENSE DRUGS!",!
+2 SET X1=DT
SET X2=-365
DO C^%DTC
SET PSXDATE=X
SET PSOUT=0
SET AAA=""
+3 FOR
SET AAA=$ORDER(^PSDRUG("B",AAA))
if AAA=""!($GET(PSOUT))
QUIT
FOR PSIEN=0:0
SET PSIEN=$ORDER(^PSDRUG("B",AAA,PSIEN))
if 'PSIEN!($GET(PSOUT))
QUIT
IF $GET(PSIEN)
IF '$PIECE($GET(^PSDRUG(PSIEN,2)),"^")
Begin DoDot:1
+4 SET APLU=$PIECE($GET(^PSDRUG(PSIEN,2)),"^",3)
+5 SET ZXX=1
SET PSXDDATE=+$PIECE($GET(^PSDRUG(PSIEN,"I")),"^")
IF PSXDDATE
IF PSXDDATE<PSXDATE
SET ZXX=0
End DoDot:1
IF ZXX
IF APLU["I"!(APLU["O")!(APLU["U")
SET PSNAME=$PIECE(^(0),"^")
DO START
CHECK DO CHECK^PSSPOIM1
+1 GOTO END^PSSPOIM1
START KILL DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,RESTART
WRITE !!!?5,"Dispense Drug -> ",PSNAME
+1 SET NODE=$GET(^PSDRUG(PSIEN,"ND"))
SET DOSEPTR=0
SET DA=$PIECE($GET(NODE),"^")
SET X=$$VAGN^PSNAPIS(DA)
SET VAGEN=X
IF +$PIECE(NODE,"^")
IF +$PIECE(NODE,"^",3)
IF $GET(VAGEN)'=0
SET K=$PIECE($GET(NODE),"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET DOSEFV=X
IF $GET(DOSEFV)'=0
Begin DoDot:1
+2 SET DOSEPTR=$PIECE(X,"^")
SET DOSEFORM=$PIECE(X,"^",2)
End DoDot:1
+3 KILL PSPOI
DO TMP
+4 DO MCH
if $GET(PSPOI)
Begin DoDot:1
+5 SET NEWFLAG=1
DO DIR^PSSPOIM3
IF $GET(PSSDIR)
WRITE !!?3,"Now editing Orderable Item:",!?3,$PIECE($GET(^PS(50.7,PSPOI,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")
DO INACT^PSSADDIT
+6 KILL NEWFLAG,PSSDIR
DO EN^PSSPOIDT(PSPOI)
KILL PSPOI
End DoDot:1
IF $GET(PSOUT)
WRITE !
SET PSOUT=0
SET RESTART=1
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to exit this option"
DO ^DIR
KILL DIR
IF Y!(Y["^")!($DATA(DTOUT))
SET PSOUT=1
+7 IF $GET(RESTART)
IF '$GET(PSOUT)
GOTO START
+8 QUIT
TMP KILL ^TMP($JOB,"PSSOO")
SET PSCNT=0
IF +$PIECE(NODE,"^")
IF +$PIECE(NODE,"^",3)
FOR ZZ=0:0
SET ZZ=$ORDER(^PSDRUG("AND",+NODE,ZZ))
if 'ZZ
QUIT
IF +$PIECE($GET(^PSDRUG(ZZ,2)),"^")
IF $PIECE(^PSDRUG(ZZ,2),"^")'=$GET(POINT)
IF $DATA(^PS(50.7,$PIECE(^PSDRUG(ZZ,2),"^"),0))
SET OTH=$GET(^PSDRUG(ZZ,"ND"))
Begin DoDot:1
+1 IF +$PIECE(OTH,"^")
IF +$PIECE(OTH,"^",3)
IF $GET(DOSEFV)'=0
SET DA=$PIECE($GET(OTH),"^")
SET K=$PIECE($GET(OTH),"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET DOSA=X
IF $GET(DOSA)'=0
IF DOSEFV=DOSA
Begin DoDot:2
+2 SET NOFLAG=0
SET TMPTR=$PIECE(^PSDRUG(ZZ,2),"^")
FOR FFF=0:0
SET FFF=$ORDER(^TMP($JOB,"PSSOO",FFF))
if 'FFF
QUIT
IF $PIECE(^TMP($JOB,"PSSOO",FFF),"^")=TMPTR
SET NOFLAG=1
+3 IF 'NOFLAG
SET PSCNT=PSCNT+1
SET ^TMP($JOB,"PSSOO",PSCNT)=$PIECE(^PSDRUG(ZZ,2),"^")_"^"_ZZ
End DoDot:2
End DoDot:1
+4 QUIT
DISP SET MATCH=0
FOR TT=0:0
SET TT=$ORDER(^TMP($JOB,"PSSOO",TT))
if 'TT
QUIT
SET SPT=$PIECE(^TMP($JOB,"PSSOO",TT),"^")
WRITE !,TT," ",$PIECE($GET(^PS(50.7,SPT,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")
IF $Y+5>IOSL
Begin DoDot:1
+1 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF Y
WRITE @IOF
WRITE !,?3,"Dispense Drug -> ",PSNAME,!
End DoDot:1
if Y=0
QUIT
IF Y=""
SET PSOUT=1
QUIT
DISPO if $GET(PSOUT)
QUIT
WRITE !
KILL DIR
SET DIR(0)="N"
SET DIR("A")="Choose number of Orderable Item to match, or '^' to enter a new one"
DO ^DIR
KILL DIR
IF Y=""!($DATA(DTOUT))
SET PSOUT=1
QUIT
+1 if Y["^"
QUIT
IF '$DATA(^TMP($JOB,"PSSOO",+Y))
WRITE !!,?5,"INVALID NUMBER"
GOTO DISPO
+2 SET MATCH=$PIECE(^TMP($JOB,"PSSOO",+Y),"^")
QUIT
+3 SET PSOUT=1
QUIT
MCH IF $ORDER(^TMP($JOB,"PSSOO",0))
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y!($DATA(DTOUT))
SET PSOUT=1
QUIT
+1 IF $ORDER(^TMP($JOB,"PSSOO",0))
DO OTHER
DO DISP
+2 if $GET(PSOUT)
QUIT
IF $ORDER(^TMP($JOB,"PSSOO",0))
IF $GET(MATCH)
SET PSSP=MATCH
DO ^PSSPOIM1
IF PSOUT!(PSNO)
SET PSOUT=1
QUIT
+3 IF $ORDER(^TMP($JOB,"PSSOO",0))
IF $GET(MATCH)
KILL DIE
SET DIE="^PSDRUG("
SET DA=PSIEN
SET DR="2.1////"_MATCH
DO ^DIE
SET PSPOI=MATCH
DO COM
QUIT
MCHA WRITE !
IF $GET(DOSEFORM)'=""
WRITE !?3,"Dose Form -> ",DOSEFORM,!!
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Match to another Orderable Item with same Dose Form"
DO ^DIR
if Y=1
GOTO LOOK
IF Y["^"!(Y="")!($DATA(DTOUT))
SET PSOUT=1
QUIT
+1 IF $GET(DOSEFORM)=""
KILL DIC
SET DIC="^PS(50.606,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Choose Dose Form: "
DO ^DIC
IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<1)
SET PSOUT=1
QUIT
+2 IF $GET(DOSEFORM)=""
SET DOSEPTR=+Y
WRITE !!?3,"Dose Form -> ",$GET(Y(0,0))
+3 IF $GET(DOSEFORM)=""
KILL DIR
WRITE !
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Match to another Orderable Item with same Dose Form"
DO ^DIR
+4 IF $GET(DOSEFORM)=""
SET DOSEFORM=$PIECE(^PS(50.606,DOSEPTR,0),"^")
if Y>0
GOTO LOOK
IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<0)
SET PSOUT=1
QUIT
MCHAN WRITE !!
IF $LENGTH(VAGEN)>40
WRITE !,"VA Generic Name -> ",VAGEN,!
+1 WRITE !,?3,"Dose Form -> ",DOSEFORM,!,?3,"Dispense Drug -> ",PSNAME,!
+2 KILL DIR
SET DIR(0)="F^3:40"
SET DIR("A")="Orderable Item Name"
if $LENGTH(VAGEN)>2&($LENGTH(VAGEN)<41)
SET DIR("B")=VAGEN
+3 DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))!(Y["^")!(Y="")
SET PSOUT=1
QUIT
+4 IF X[""""!($ASCII(X)=45)!('(X'?1P.E))!(X?2"z".E)
WRITE $CHAR(7),!!?5,"??"
GOTO MCHAN
+5 SET X=Y
SET SPHOLD=X
SET (STOP,PSNO)=0
FOR COMM=0:0
SET COMM=$ORDER(^PS(50.7,"ADF",SPHOLD,DOSEPTR,COMM))
if 'COMM!(STOP)!($GET(PSOUT))
QUIT
IF COMM
IF $PIECE($GET(^PS(50.7,COMM,0)),"^",3)=""
Begin DoDot:1
+6 SET PSSP=COMM
DO ^PSSPOIM1
if PSNO
SET STOP=1
if PSOUT!(STOP)
QUIT
KILL DIE
SET DIE="^PSDRUG("
SET DA=PSIEN
SET DR="2.1////"_COMM
DO ^DIE
SET PSPOI=COMM
DO COM
SET STOP=1
QUIT
End DoDot:1
+7 if PSOUT
QUIT
+8 IF STOP
IF $GET(PSNO)
GOTO MCHAN
+9 if STOP
QUIT
+10 SET PSMAN=1
DO ^PSSPOIM1
if PSNO
GOTO MCHAN
if PSOUT
QUIT
KILL DIC
SET DIC="^PS(50.7,"
SET DIC(0)="L"
SET X=SPHOLD
SET DIC("DR")=".02////"_DOSEPTR
KILL DD,DO
DO FILE^DICN
if Y<1
Begin DoDot:1
+11 WRITE $CHAR(7),!?5,"Unable to create entry, try again!",!!
QUIT
End DoDot:1
if (Y<1)
GOTO MCHAN
SET NEWSP=+Y
SET DIE="^PSDRUG("
SET DA=PSIEN
SET DR="2.1////"_NEWSP
DO ^DIE
DO COM
QUIT
+12 QUIT
LOOK WRITE !!!?3,"Enter ?? for Pharmacy Orderable Item List!"
+1 WRITE !
KILL DIC
SET DIC="^PS(50.7,"
SET DIC(0)="QEAM"
SET DIC("S")="I $P($G(^(0)),""^"",2)=DOSEPTR,$P($G(^(0)),""^"",3)="""""
DO ^DIC
IF Y>0
KILL DIC("S")
SET (NEWSP,PSSP)=+Y
DO ^PSSPOIM1
if PSNO
GOTO LOOK
if PSOUT
QUIT
SET DIE="^PSDRUG("
SET DA=PSIEN
SET DR="2.1////"_NEWSP
DO ^DIE
DO COM
QUIT
+2 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Create a new Orderable Item to match"
DO ^DIR
IF Y=1
GOTO MCHAN
+3 SET PSOUT=1
QUIT
COM WRITE !,"Match Complete!",!
if '$GET(PSPOI)
SET PSPOI=$GET(NEWSP)
QUIT
OTHER WRITE @IOF
WRITE !,"There are other Dispense Drugs with the same VA Generic Name and same Dose",!,"Form already matched to orderable items. Choose a number to match, or enter",!,"'^' to enter a new one.",!!?6,"Disp. drug -> ",PSNAME,!
QUIT
WOOPS if $DATA(^TMP("PSSLOOP"))
WRITE !!,$CHAR(7),"Sorry, but someone else is using this option.",!
+1 QUIT
