PXCEAE2 ;ISL/dee - Used to select the visit or a v-file entry for the display ;6/20/96
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
;;
Q
SEL(HELP,MIN) ; Select list of entries
N X,Y,MAX,SEL,X1,X2,INDEX1,INDEX2
S MAX=+$G(^TMP("PXCEAEIX",$J,0)) I MAX<MIN Q "^"
S (Y,SEL)=$P($P(XQORNOD(0),"^",4),"=",2)
I SEL]"" F INDEX1=1:1 S X1=$P(SEL,",",INDEX1) Q:X1']"" D
. I $L(X1,"-")>1,$L(X1,"-")>2!($P(X1,"-",1)'<$P(X1,"-",2)) D
.. W !,$C(7),"Selection '",X1,"' is not a valid choice."
.. D WAIT^PXCEHELP
.. S (Y,X1)="^"
. E F INDEX2=1:1:2 S X2=$P(X1,"-",INDEX2) Q:X2']"" D
.. I (+X2'=X2)!(+X2>MAX)!(+X2<MIN)!(X2#1'=0) D
... W !,$C(7),"Selection '",X2,"' is not a valid choice."
... D WAIT^PXCEHELP
... S Y="^"
E D
. N DIR,DA
. S DIR(0)="LAO^"_MIN_":"_MAX
. S DIR("A")="Select Entry(s)"
. S:MAX>MIN DIR("A")=DIR("A")_" ("_MIN_"-"_MAX_"): "
. S:MAX'>MIN DIR("A")=DIR("A")_": ",DIR("B")=MIN
. S DIR("?")="Enter the entries you wish to "
. S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")_", as a range or list of numbers"
. D ^DIR
. I $D(DTOUT)!(X="") S Y="^"
Q Y
;
SEL1(HELP,MIN) ; Select 1 entry
N X,Y,MAX
S MAX=+$G(^TMP("PXCEAEIX",$J,0))
I MAX<MIN W !,$C(7),"There are no valid choices." D WAIT^PXCEHELP Q "^"
S Y=$P($P(XQORNOD(0),"^",4),"=",2)
I Y]"" D
. I (+Y'=Y)!(+Y>MAX)!(+Y<MIN)!(Y#1'=0) D
.. W !,$C(7),"Selection '",Y,"' is not a valid choice."
.. D WAIT^PXCEHELP
.. S Y="^"
E D
. N DIR,DA
. S DIR(0)="NAO^"_MIN_":"_MAX_":0",DIR("A")="Select Entry"
. S:MAX>MIN DIR("A")=DIR("A")_" ("_MIN_"-"_MAX_"): "
. S:MAX'>MIN DIR("A")=DIR("A")_": ",DIR("B")=MIN
. S DIR("?")="Enter the number of the entry you wish to "
. S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")
. D ^DIR
. I $D(DTOUT)!(X="") S Y="^"
Q Y
;
SURE() ; Verify delete request, returns 1 if YES, else 0
N DIR,DA,X,Y
S DIR(0)="YA",DIR("B")="NO"
S DIR("?")="Enter YES to remove this entry or NO to leave it unchanged."
S DIR("A")="Are you sure you want to remove this entry? "
D ^DIR
Q +Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEAE2 2064 printed Nov 22, 2024@17:37:52 Page 2
PXCEAE2 ;ISL/dee - Used to select the visit or a v-file entry for the display ;6/20/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
+2 ;;
+3 QUIT
SEL(HELP,MIN) ; Select list of entries
+1 NEW X,Y,MAX,SEL,X1,X2,INDEX1,INDEX2
+2 SET MAX=+$GET(^TMP("PXCEAEIX",$JOB,0))
IF MAX<MIN
QUIT "^"
+3 SET (Y,SEL)=$PIECE($PIECE(XQORNOD(0),"^",4),"=",2)
+4 IF SEL]""
FOR INDEX1=1:1
SET X1=$PIECE(SEL,",",INDEX1)
if X1']""
QUIT
Begin DoDot:1
+5 IF $LENGTH(X1,"-")>1
IF $LENGTH(X1,"-")>2!($PIECE(X1,"-",1)'<$PIECE(X1,"-",2))
Begin DoDot:2
+6 WRITE !,$CHAR(7),"Selection '",X1,"' is not a valid choice."
+7 DO WAIT^PXCEHELP
+8 SET (Y,X1)="^"
End DoDot:2
+9 IF '$TEST
FOR INDEX2=1:1:2
SET X2=$PIECE(X1,"-",INDEX2)
if X2']""
QUIT
Begin DoDot:2
+10 IF (+X2'=X2)!(+X2>MAX)!(+X2<MIN)!(X2#1'=0)
Begin DoDot:3
+11 WRITE !,$CHAR(7),"Selection '",X2,"' is not a valid choice."
+12 DO WAIT^PXCEHELP
+13 SET Y="^"
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 NEW DIR,DA
+16 SET DIR(0)="LAO^"_MIN_":"_MAX
+17 SET DIR("A")="Select Entry(s)"
+18 if MAX>MIN
SET DIR("A")=DIR("A")_" ("_MIN_"-"_MAX_"): "
+19 if MAX'>MIN
SET DIR("A")=DIR("A")_": "
SET DIR("B")=MIN
+20 SET DIR("?")="Enter the entries you wish to "
+21 SET DIR("?")=DIR("?")_$SELECT($LENGTH(HELP):HELP,1:"act on")_", as a range or list of numbers"
+22 DO ^DIR
+23 IF $DATA(DTOUT)!(X="")
SET Y="^"
End DoDot:1
+24 QUIT Y
+25 ;
SEL1(HELP,MIN) ; Select 1 entry
+1 NEW X,Y,MAX
+2 SET MAX=+$GET(^TMP("PXCEAEIX",$JOB,0))
+3 IF MAX<MIN
WRITE !,$CHAR(7),"There are no valid choices."
DO WAIT^PXCEHELP
QUIT "^"
+4 SET Y=$PIECE($PIECE(XQORNOD(0),"^",4),"=",2)
+5 IF Y]""
Begin DoDot:1
+6 IF (+Y'=Y)!(+Y>MAX)!(+Y<MIN)!(Y#1'=0)
Begin DoDot:2
+7 WRITE !,$CHAR(7),"Selection '",Y,"' is not a valid choice."
+8 DO WAIT^PXCEHELP
+9 SET Y="^"
End DoDot:2
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 NEW DIR,DA
+12 SET DIR(0)="NAO^"_MIN_":"_MAX_":0"
SET DIR("A")="Select Entry"
+13 if MAX>MIN
SET DIR("A")=DIR("A")_" ("_MIN_"-"_MAX_"): "
+14 if MAX'>MIN
SET DIR("A")=DIR("A")_": "
SET DIR("B")=MIN
+15 SET DIR("?")="Enter the number of the entry you wish to "
+16 SET DIR("?")=DIR("?")_$SELECT($LENGTH(HELP):HELP,1:"act on")
+17 DO ^DIR
+18 IF $DATA(DTOUT)!(X="")
SET Y="^"
End DoDot:1
+19 QUIT Y
+20 ;
SURE() ; Verify delete request, returns 1 if YES, else 0
+1 NEW DIR,DA,X,Y
+2 SET DIR(0)="YA"
SET DIR("B")="NO"
+3 SET DIR("?")="Enter YES to remove this entry or NO to leave it unchanged."
+4 SET DIR("A")="Are you sure you want to remove this entry? "
+5 DO ^DIR
+6 QUIT +Y
+7 ;
