PXQPVST.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXQPVST   6503     printed  Nov 22, 2024@17:40:13                                                                                                                                                                                                     Page 2

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