PXQPVST ;ISL/JVS - PROMPT FOR VISITS (ENCOUNTERS) ;8/29/96 10:33
;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
;
Q
VST ;--PROMPTS FOR VISITS
N X,Y,ADD,DATA,DOUG,DEL,DIRUT
D LOC^PXBCC(15,0),WIN17^PXBCC(PXBCNT)
W !,IOCUD,IOELALL,IOCUD,IOELALL,IOCUU,IOCUU
;
I $G(PROMPT)="A" G PRADD
I $G(PROMPT)="D" G PRDEL
I $G(PROMPT)["AD"!($G(PROMPT)["DA") G BOTH
;
PRMPT ;
S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
I $G(PXBCNT)'>0 S DIR("A",1)=""
;
;
S DIR("?")="Enter item number or '-' to backup a screen or RETURN for next screen or '^' to exit."
I $G(PXBCNT)'>0 S DIR("?")="Enter 'RETURN' or '^' to exit this screen."
;
;
S DIR("A")="Select Encounter by entering the ITEM No. : "
I $G(PXBCNT)'>0 S DIR("A")="'RETURN' or '^' to exit: "
S DIR(0)="FAO^1:3"
D ^DIR K DIR
G VERIFY
;
PRADD ;
S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
I $G(PXBCNT)'>0 S DIR("A",1)=""
;
;
S DIR("?")="Enter item number or A to add a new encounter or '-' to backup a screen or RETURN for next screen or '^' to exit."
I $G(PXBCNT)'>0 S DIR("?")="Enter A to add a new encounter, 'RETURN' or '^' to exit this screen."
;
;
S DIR("A")="Select ITEM No. or 'A' to ADD an Encounter: "
I $G(PXBCNT)'>0 S DIR("A")="Select 'A' to ADD or 'RETURN' to exit: "
S DIR(0)="FAO^1:3"
D ^DIR K DIR
G VERIFY
;
PRDEL ;
S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
I $G(PXBCNT)'>0 S DIR("A",1)=""
;
;
S DIR("?")="Enter item number or '@' folowed by the 'ITEM No.'(eg @9) to delete an encounter or '-' to backup a screen or 'RETURN' for next screen or '^' to exit."
I $G(PXBCNT)'>0 S DIR("?")="Enter 'RETURN' or '^' to exit this screen."
;
;
S DIR("A")="Select ITEM No. or '@ITEM No.' to DELETE an Encounter: "
I $G(PXBCNT)'>0 S DIR("A")="Enter 'RETURN' or '^' to exit this screen: "
S DIR(0)="FAO^1:3"
D ^DIR K DIR
G VERIFY
;
BOTH ;
S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
I $G(PXBCNT)'>0 S DIR("A",1)=""
;
;
S DIR("?")="Enter item number or A to add, or '@' followed by the 'ITEM No.'(eg @7) to DELETE a new encounter or '-' to backup a screen or 'RETURN' for next screen or '^' to exit."
I $G(PXBCNT)'>0 S DIR("?")="Enter item number or, A to add an encounter, 'RETURN' or '^' to exit this screen."
;
;
S DIR("A")="Select ITEM No. or 'A' to ADD or '@ITEM No.' to DELETE: "
I $G(PXBCNT)'>0 S DIR("A")="Select 'A' to ADD or 'RETURN' to exit: "
S DIR(0)="FAO^1:3"
D ^DIR K DIR
G VERIFY
;
;
VERIFY ;--VERIFY INPUT
;
;
S EDATA=$G(Y) D CASE^PXBUTL S (X,Y)=EDATA K EDATA
I $G(PROMPT)="A" G VERADD
I $G(PROMPT)="D" G VERDEL
I $G(PROMPT)["AD"!($G(PROMPT)["DA") G VERBOTH
;
VER ;
;
I $G(PXBCNT)>0 S DOUG="-^" I DOUG'[Y&(Y'?1.3N) W IOELEOL,! D HELP1^PXBUTL1("VST2") G VST
I $G(PXBCNT)'>0 S DOUG="^" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
;
;
I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
I Y="" D DVST42^PXQDVST2("+") G VST
I Y="-" D DVST42^PXQDVST2("-") G VST
I $D(DIRUT) S VAL=-1
I Y?1.3N,Y'>PXBCNT S VAL=$O(^TMP("PXBSKY",$J,Y,0))
G EXIT
VERADD ;
;
I $G(PXBCNT)>0 S DOUG="-^A" I DOUG'[Y&(Y'?1.3N) W ! D HELP1^PXBUTL1("VST2") G VST
I $G(PXBCNT)'>0 S DOUG="^A" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
;
;
I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
I Y="" D DVST42^PXQDVST2("+") G VST
I Y="-" D DVST42^PXQDVST2("-") G VST
I $D(DIRUT) S VAL=-1
I Y?.A S DATA=Y D CASE^PXBUTL S Y=DATA
S DOUG="ADD" I DOUG[Y S VAL="A"
I Y?1.3N,Y'>PXBCNT S VAL=$O(^TMP("PXBSKY",$J,Y,0))
G EXIT
VERDEL ;
;
I $G(PXBCNT)>0 S DOUG="-^" I DOUG'[Y&(Y'?1.3N)&($E(Y,1)'["@") W ! D HELP1^PXBUTL1("VST2") G VST
I $G(PXBCNT)'>0 S DOUG="^" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
;
;
I $E(Y,1)["@" S Y=$E(Y,2,4),DEL=1
I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
I Y="" D DVST42^PXQDVST2("+") G VST
I Y="-" D DVST42^PXQDVST2("-") G VST
I $D(DIRUT) S VAL=-1
I Y?.A S DATA=Y D CASE^PXBUTL S Y=DATA
I $G(DEL) S VAL="D^"_$O(^TMP("PXBSKY",$J,Y,0))
I Y?1.3N,Y'>PXBCNT,'$G(DEL) S VAL=$O(^TMP("PXBSKY",$J,Y,0))
G EXIT
VERBOTH ;
;
I $G(PXBCNT)>0 S DOUG="-^A" I DOUG'[Y&(Y'?1.3N)&($E(Y,1)'["@") W ! D HELP1^PXBUTL1("VST2") G VST
I $G(PXBCNT)'>0 S DOUG="^A" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
;
;
I $E(Y,1)["@" S Y=$E(Y,2,4),DEL=1
I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
I Y="" D DVST42^PXQDVST2("+") G VST
I Y="-" D DVST42^PXQDVST2("-") G VST
I $D(DIRUT) S VAL=-1
I Y?.A S DATA=Y D CASE^PXBUTL S Y=DATA
S DOUG="A" I DOUG[Y S VAL="A"
I $G(DEL) S VAL="D^"_$O(^TMP("PXBSKY",$J,Y,0))
I Y?1.3N,Y'>PXBCNT,'$G(DEL) S VAL=$O(^TMP("PXBSKY",$J,Y,0))
G EXIT
CONFIRM ;---CONFIRM A REQUEST NOT ON THE SCREEN
D DVST42^PXQDVST2(Y)
N PXBLINE,PXBCOLM,PXBENT,ENTRY,YY
S YY=Y
S PXBLINE=(Y#10)+3 I Y#10=0,Y\10>0 S PXBLINE=(PXBLINE)+(10)
S PXBCOLM=4
S PXBENT=$G(^TMP("PXBSAM",$J,Y))
S ENTRY=$P(PXBENT,"^",1)
D RREVST^PXBCC(PXBLINE,PXBCOLM,ENTRY)
;
S DIR(0)="YA"
S DIR("B")="YES"
S DIR("A")="Is this the entry you selected? "
D ^DIR K DIR
I Y=1,'$G(DEL) S VAL=$O(^TMP("PXBSKY",$J,YY,0)) G EXIT
I Y=1,$G(DEL) S VAL="D^"_$O(^TMP("PXBSKY",$J,YY,0)) G EXIT
I Y=0 G VST
G EXIT
;
EXIT ;
;
;
Q
PXQPVST ;ISL/JVS - PROMPT FOR VISITS (ENCOUNTERS) ;8/29/96 10:33
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
+2 ;
+3 QUIT
VST ;--PROMPTS FOR VISITS
+1 NEW X,Y,ADD,DATA,DOUG,DEL,DIRUT
+2 DO LOC^PXBCC(15,0)
DO WIN17^PXBCC(PXBCNT)
+3 WRITE !,IOCUD,IOELALL,IOCUD,IOELALL,IOCUU,IOCUU
+4 ;
+5 IF $GET(PROMPT)="A"
GOTO PRADD
+6 IF $GET(PROMPT)="D"
GOTO PRDEL
+7 IF $GET(PROMPT)["AD"!($GET(PROMPT)["DA")
GOTO BOTH
+8 ;
PRMPT ;
+1 SET DIR("A",1)="'RETURN' to continue or '-' for previous screen"
+2 IF $GET(PXBCNT)'>0
SET DIR("A",1)=""
+3 ;
+4 ;
+5 SET DIR("?")="Enter item number or '-' to backup a screen or RETURN for next screen or '^' to exit."
+6 IF $GET(PXBCNT)'>0
SET DIR("?")="Enter 'RETURN' or '^' to exit this screen."
+7 ;
+8 ;
+9 SET DIR("A")="Select Encounter by entering the ITEM No. : "
+10 IF $GET(PXBCNT)'>0
SET DIR("A")="'RETURN' or '^' to exit: "
+11 SET DIR(0)="FAO^1:3"
+12 DO ^DIR
KILL DIR
+13 GOTO VERIFY
+14 ;
PRADD ;
+1 SET DIR("A",1)="'RETURN' to continue or '-' for previous screen"
+2 IF $GET(PXBCNT)'>0
SET DIR("A",1)=""
+3 ;
+4 ;
+5 SET DIR("?")="Enter item number or A to add a new encounter or '-' to backup a screen or RETURN for next screen or '^' to exit."
+6 IF $GET(PXBCNT)'>0
SET DIR("?")="Enter A to add a new encounter, 'RETURN' or '^' to exit this screen."
+7 ;
+8 ;
+9 SET DIR("A")="Select ITEM No. or 'A' to ADD an Encounter: "
+10 IF $GET(PXBCNT)'>0
SET DIR("A")="Select 'A' to ADD or 'RETURN' to exit: "
+11 SET DIR(0)="FAO^1:3"
+12 DO ^DIR
KILL DIR
+13 GOTO VERIFY
+14 ;
PRDEL ;
+1 SET DIR("A",1)="'RETURN' to continue or '-' for previous screen"
+2 IF $GET(PXBCNT)'>0
SET DIR("A",1)=""
+3 ;
+4 ;
+5 SET DIR("?")="Enter item number or '@' folowed by the 'ITEM No.'(eg @9) to delete an encounter or '-' to backup a screen or 'RETURN' for next screen or '^' to exit."
+6 IF $GET(PXBCNT)'>0
SET DIR("?")="Enter 'RETURN' or '^' to exit this screen."
+7 ;
+8 ;
+9 SET DIR("A")="Select ITEM No. or '@ITEM No.' to DELETE an Encounter: "
+10 IF $GET(PXBCNT)'>0
SET DIR("A")="Enter 'RETURN' or '^' to exit this screen: "
+11 SET DIR(0)="FAO^1:3"
+12 DO ^DIR
KILL DIR
+13 GOTO VERIFY
+14 ;
BOTH ;
+1 SET DIR("A",1)="'RETURN' to continue or '-' for previous screen"
+2 IF $GET(PXBCNT)'>0
SET DIR("A",1)=""
+3 ;
+4 ;
+5 SET DIR("?")="Enter item number or A to add, or '@' followed by the 'ITEM No.'(eg @7) to DELETE a new encounter or '-' to backup a screen or 'RETURN' for next screen or '^' to exit."
+6 IF $GET(PXBCNT)'>0
SET DIR("?")="Enter item number or, A to add an encounter, 'RETURN' or '^' to exit this screen."
+7 ;
+8 ;
+9 SET DIR("A")="Select ITEM No. or 'A' to ADD or '@ITEM No.' to DELETE: "
+10 IF $GET(PXBCNT)'>0
SET DIR("A")="Select 'A' to ADD or 'RETURN' to exit: "
+11 SET DIR(0)="FAO^1:3"
+12 DO ^DIR
KILL DIR
+13 GOTO VERIFY
+14 ;
+15 ;
VERIFY ;--VERIFY INPUT
+1 ;
+2 ;
+3 SET EDATA=$GET(Y)
DO CASE^PXBUTL
SET (X,Y)=EDATA
KILL EDATA
+4 IF $GET(PROMPT)="A"
GOTO VERADD
+5 IF $GET(PROMPT)="D"
GOTO VERDEL
+6 IF $GET(PROMPT)["AD"!($GET(PROMPT)["DA")
GOTO VERBOTH
+7 ;
VER ;
+1 ;
+2 IF $GET(PXBCNT)>0
SET DOUG="-^"
IF DOUG'[Y&(Y'?1.3N)
WRITE IOELEOL,!
DO HELP1^PXBUTL1("VST2")
GOTO VST
+3 IF $GET(PXBCNT)'>0
SET DOUG="^"
IF DOUG'[Y
WRITE !
DO HELP1^PXBUTL1("VST2")
GOTO VST
+4 ;
+5 ;
+6 IF Y?1.3N
IF Y>$GET(PXBHIGH)
WRITE !
DO HELP1^PXBUTL1("VST1")
GOTO VST
+7 IF Y=0!(Y="00")!(Y="000")
WRITE !
DO HELP1^PXBUTL1("VST3")
GOTO VST
+8 IF Y#1!(Y<0)
WRITE !
DO HELP1^PXBUTL1("VST4")
GOTO VST
+9 IF Y?1.3N
IF Y'>$GET(^TMP("PXBDVST",$JOB,"START"))
GOTO CONFIRM
+10 IF Y?1.3N
IF Y'<($GET(^TMP("PXBDVST",$JOB,"START"))+10)
GOTO CONFIRM
+11 IF Y=""
IF ($GET(^TMP("PXBDVST",$JOB,"START"))+10)'<$GET(PXBCNT)
SET VAL=-1
QUIT
+12 IF Y=""
DO DVST42^PXQDVST2("+")
GOTO VST
+13 IF Y="-"
DO DVST42^PXQDVST2("-")
GOTO VST
+14 IF $DATA(DIRUT)
SET VAL=-1
+15 IF Y?1.3N
IF Y'>PXBCNT
SET VAL=$ORDER(^TMP("PXBSKY",$JOB,Y,0))
+16 GOTO EXIT
VERADD ;
+1 ;
+2 IF $GET(PXBCNT)>0
SET DOUG="-^A"
IF DOUG'[Y&(Y'?1.3N)
WRITE !
DO HELP1^PXBUTL1("VST2")
GOTO VST
+3 IF $GET(PXBCNT)'>0
SET DOUG="^A"
IF DOUG'[Y
WRITE !
DO HELP1^PXBUTL1("VST2")
GOTO VST
+4 ;
+5 ;
+6 IF Y?1.3N
IF Y>$GET(PXBHIGH)
WRITE !
DO HELP1^PXBUTL1("VST1")
GOTO VST
+7 IF Y=0!(Y="00")!(Y="000")
WRITE !
DO HELP1^PXBUTL1("VST3")
GOTO VST
+8 IF Y#1!(Y<0)
WRITE !
DO HELP1^PXBUTL1("VST4")
GOTO VST
+9 IF Y?1.3N
IF Y'>$GET(^TMP("PXBDVST",$JOB,"START"))
GOTO CONFIRM
+10 IF Y?1.3N
IF Y'<($GET(^TMP("PXBDVST",$JOB,"START"))+10)
GOTO CONFIRM
+11 IF Y=""
IF ($GET(^TMP("PXBDVST",$JOB,"START"))+10)'<$GET(PXBCNT)
SET VAL=-1
QUIT
+12 IF Y=""
DO DVST42^PXQDVST2("+")
GOTO VST
+13 IF Y="-"
DO DVST42^PXQDVST2("-")
GOTO VST
+14 IF $DATA(DIRUT)
SET VAL=-1
+15 IF Y?.A
SET DATA=Y
DO CASE^PXBUTL
SET Y=DATA
+16 SET DOUG="ADD"
IF DOUG[Y
SET VAL="A"
+17 IF Y?1.3N
IF Y'>PXBCNT
SET VAL=$ORDER(^TMP("PXBSKY",$JOB,Y,0))
+18 GOTO EXIT
VERDEL ;
+1 ;
+2 IF $GET(PXBCNT)>0
SET DOUG="-^"
IF DOUG'[Y&(Y'?1.3N)&($EXTRACT(Y,1)'["@")
WRITE !
DO HELP1^PXBUTL1("VST2")
GOTO VST
+3 IF $GET(PXBCNT)'>0
SET DOUG="^"
IF DOUG'[Y
WRITE !
DO HELP1^PXBUTL1("VST2")
GOTO VST
+4 ;
+5 ;
+6 IF $EXTRACT(Y,1)["@"
SET Y=$EXTRACT(Y,2,4)
SET DEL=1
+7 IF Y?1.3N
IF Y>$GET(PXBHIGH)
WRITE !
DO HELP1^PXBUTL1("VST1")
GOTO VST
+8 IF Y=0!(Y="00")!(Y="000")
WRITE !
DO HELP1^PXBUTL1("VST3")
GOTO VST
+9 IF Y#1!(Y<0)
WRITE !
DO HELP1^PXBUTL1("VST4")
GOTO VST
+10 IF Y?1.3N
IF Y'>$GET(^TMP("PXBDVST",$JOB,"START"))
GOTO CONFIRM
+11 IF Y?1.3N
IF Y'<($GET(^TMP("PXBDVST",$JOB,"START"))+10)
GOTO CONFIRM
+12 IF Y=""
IF ($GET(^TMP("PXBDVST",$JOB,"START"))+10)'<$GET(PXBCNT)
SET VAL=-1
QUIT
+13 IF Y=""
DO DVST42^PXQDVST2("+")
GOTO VST
+14 IF Y="-"
DO DVST42^PXQDVST2("-")
GOTO VST
+15 IF $DATA(DIRUT)
SET VAL=-1
+16 IF Y?.A
SET DATA=Y
DO CASE^PXBUTL
SET Y=DATA
+17 IF $GET(DEL)
SET VAL="D^"_$ORDER(^TMP("PXBSKY",$JOB,Y,0))
+18 IF Y?1.3N
IF Y'>PXBCNT
IF '$GET(DEL)
SET VAL=$ORDER(^TMP("PXBSKY",$JOB,Y,0))
+19 GOTO EXIT
VERBOTH ;
+1 ;
+2 IF $GET(PXBCNT)>0
SET DOUG="-^A"
IF DOUG'[Y&(Y'?1.3N)&($EXTRACT(Y,1)'["@")
WRITE !
DO HELP1^PXBUTL1("VST2")
GOTO VST
+3 IF $GET(PXBCNT)'>0
SET DOUG="^A"
IF DOUG'[Y
WRITE !
DO HELP1^PXBUTL1("VST2")
GOTO VST
+4 ;
+5 ;
+6 IF $EXTRACT(Y,1)["@"
SET Y=$EXTRACT(Y,2,4)
SET DEL=1
+7 IF Y?1.3N
IF Y>$GET(PXBHIGH)
WRITE !
DO HELP1^PXBUTL1("VST1")
GOTO VST
+8 IF Y=0!(Y="00")!(Y="000")
WRITE !
DO HELP1^PXBUTL1("VST3")
GOTO VST
+9 IF Y#1!(Y<0)
WRITE !
DO HELP1^PXBUTL1("VST4")
GOTO VST
+10 IF Y?1.3N
IF Y'>$GET(^TMP("PXBDVST",$JOB,"START"))
GOTO CONFIRM
+11 IF Y?1.3N
IF Y'<($GET(^TMP("PXBDVST",$JOB,"START"))+10)
GOTO CONFIRM
+12 IF Y=""
IF ($GET(^TMP("PXBDVST",$JOB,"START"))+10)'<$GET(PXBCNT)
SET VAL=-1
QUIT
+13 IF Y=""
DO DVST42^PXQDVST2("+")
GOTO VST
+14 IF Y="-"
DO DVST42^PXQDVST2("-")
GOTO VST
+15 IF $DATA(DIRUT)
SET VAL=-1
+16 IF Y?.A
SET DATA=Y
DO CASE^PXBUTL
SET Y=DATA
+17 SET DOUG="A"
IF DOUG[Y
SET VAL="A"
+18 IF $GET(DEL)
SET VAL="D^"_$ORDER(^TMP("PXBSKY",$JOB,Y,0))
+19 IF Y?1.3N
IF Y'>PXBCNT
IF '$GET(DEL)
SET VAL=$ORDER(^TMP("PXBSKY",$JOB,Y,0))
+20 GOTO EXIT
CONFIRM ;---CONFIRM A REQUEST NOT ON THE SCREEN
+1 DO DVST42^PXQDVST2(Y)
+2 NEW PXBLINE,PXBCOLM,PXBENT,ENTRY,YY
+3 SET YY=Y
+4 SET PXBLINE=(Y#10)+3
IF Y#10=0
IF Y\10>0
SET PXBLINE=(PXBLINE)+(10)
+5 SET PXBCOLM=4
+6 SET PXBENT=$GET(^TMP("PXBSAM",$JOB,Y))
+7 SET ENTRY=$PIECE(PXBENT,"^",1)
+8 DO RREVST^PXBCC(PXBLINE,PXBCOLM,ENTRY)
+9 ;
+10 SET DIR(0)="YA"
+11 SET DIR("B")="YES"
+12 SET DIR("A")="Is this the entry you selected? "
+13 DO ^DIR
KILL DIR
+14 IF Y=1
IF '$GET(DEL)
SET VAL=$ORDER(^TMP("PXBSKY",$JOB,YY,0))
GOTO EXIT
+15 IF Y=1
IF $GET(DEL)
SET VAL="D^"_$ORDER(^TMP("PXBSKY",$JOB,YY,0))
GOTO EXIT
+16 IF Y=0
GOTO VST
+17 GOTO EXIT
+18 ;
EXIT ;
+1 ;
+2 ;
+3 QUIT