source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEAE2.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1PXCEAE2 ;ISL/dee - Used to select the visit or a v-file entry for the display ;6/20/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
3 ;;
4 Q
5SEL(HELP,MIN) ; Select list of entries
6 N X,Y,MAX,SEL,X1,X2,INDEX1,INDEX2
7 S MAX=+$G(^TMP("PXCEAEIX",$J,0)) I MAX<MIN Q "^"
8 S (Y,SEL)=$P($P(XQORNOD(0),"^",4),"=",2)
9 I SEL]"" F INDEX1=1:1 S X1=$P(SEL,",",INDEX1) Q:X1']"" D
10 . I $L(X1,"-")>1,$L(X1,"-")>2!($P(X1,"-",1)'<$P(X1,"-",2)) D
11 .. W !,$C(7),"Selection '",X1,"' is not a valid choice."
12 .. D WAIT^PXCEHELP
13 .. S (Y,X1)="^"
14 . E F INDEX2=1:1:2 S X2=$P(X1,"-",INDEX2) Q:X2']"" D
15 .. I (+X2'=X2)!(+X2>MAX)!(+X2<MIN)!(X2#1'=0) D
16 ... W !,$C(7),"Selection '",X2,"' is not a valid choice."
17 ... D WAIT^PXCEHELP
18 ... S Y="^"
19 E D
20 . N DIR,DA
21 . S DIR(0)="LAO^"_MIN_":"_MAX
22 . S DIR("A")="Select Entry(s)"
23 . S:MAX>MIN DIR("A")=DIR("A")_" ("_MIN_"-"_MAX_"): "
24 . S:MAX'>MIN DIR("A")=DIR("A")_": ",DIR("B")=MIN
25 . S DIR("?")="Enter the entries you wish to "
26 . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")_", as a range or list of numbers"
27 . D ^DIR
28 . I $D(DTOUT)!(X="") S Y="^"
29 Q Y
30 ;
31SEL1(HELP,MIN) ; Select 1 entry
32 N X,Y,MAX
33 S MAX=+$G(^TMP("PXCEAEIX",$J,0))
34 I MAX<MIN W !,$C(7),"There are no valid choices." D WAIT^PXCEHELP Q "^"
35 S Y=$P($P(XQORNOD(0),"^",4),"=",2)
36 I Y]"" D
37 . I (+Y'=Y)!(+Y>MAX)!(+Y<MIN)!(Y#1'=0) D
38 .. W !,$C(7),"Selection '",Y,"' is not a valid choice."
39 .. D WAIT^PXCEHELP
40 .. S Y="^"
41 E D
42 . N DIR,DA
43 . S DIR(0)="NAO^"_MIN_":"_MAX_":0",DIR("A")="Select Entry"
44 . S:MAX>MIN DIR("A")=DIR("A")_" ("_MIN_"-"_MAX_"): "
45 . S:MAX'>MIN DIR("A")=DIR("A")_": ",DIR("B")=MIN
46 . S DIR("?")="Enter the number of the entry you wish to "
47 . S DIR("?")=DIR("?")_$S($L(HELP):HELP,1:"act on")
48 . D ^DIR
49 . I $D(DTOUT)!(X="") S Y="^"
50 Q Y
51 ;
52SURE() ; Verify delete request, returns 1 if YES, else 0
53 N DIR,DA,X,Y
54 S DIR(0)="YA",DIR("B")="NO"
55 S DIR("?")="Enter YES to remove this entry or NO to leave it unchanged."
56 S DIR("A")="Are you sure you want to remove this entry? "
57 D ^DIR
58 Q +Y
59 ;
Note: See TracBrowser for help on using the repository browser.