source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPURS0.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1PRCPURS0 ;WISC/RFJ-ask sort, select acct, select nsn, select item ;17 May 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7SORTBY() ; select type of sort
8 N DIR,X,Y
9 S DIR(0)="S^1:ACCOUNT CODE;2:NSN",DIR("A")="Sort BY",DIR("B")="ACCOUNT CODE" D ^DIR K DIR I Y'=1,Y'=2 Q 0
10 Q +Y
11 ;
12 ;
13SUMMARY() ; print summary only
14 N %,X
15 K X S X(1)="Display Summary or ALL Data." D DISPLAY^PRCPUX2(2,40,.X)
16 S XP="Do you want to print a summary only",XH="Enter 'YES' to print a summary, 'NO' to print entire report, '^' to exit."
17 S %=$$YN^PRCPUYN(1)
18 Q $S(%=1:1,%=2:0,1:-1)
19 ;
20 ;
21ACCTSEL ; pick account codes or all
22 ; returns array of accounts selected
23 N %,A,DIR,DIRUT,DTOUT,DUOUT,PRCPEXIT,PRCPFLAG,PRCPLINE,X,Y
24 S PRCPLINE="",$P(PRCPLINE,"-",78)=""
25 K ACCOUNT
26 F %=1,2,3,6,8 S ACCOUNT("NO",%)=""
27 F D I $G(PRCPFLAG) Q
28 . W !
29 . I $O(ACCOUNT("YES",0)) D
30 . . W !?2,PRCPLINE,!?2,"| Currently selected account codes : "
31 . . S A=0 F S A=$O(ACCOUNT("YES",A)) Q:'A W A W:$O(ACCOUNT("YES",A)) ", "
32 . . W ?78,"|",!?2,"| You can DE-select one of the above account codes by reselecting it.",?78,"|"
33 . I $O(ACCOUNT("NO",0)) D
34 . . W !?2,PRCPLINE,!?2,"| Currently DE-selected account codes: "
35 . . S A=0 F S A=$O(ACCOUNT("NO",A)) Q:'A W A W:$O(ACCOUNT("NO",A)) ", "
36 . . W ?78,"|",!?2,"| You can RE-select one of the above account codes by reselecting it.",?78,"|"
37 . W !?2,PRCPLINE
38 . S DIR(0)="SBO^1:Account Code 1;2:Account Code 2;3:Account Code 3;6:Account Code 6;8:Account Code 8;",DIR("A")="Select ACCOUNT Code" D ^DIR I $D(DTOUT)!($D(DUOUT)) S (PRCPFLAG,PRCPEXIT)=1 Q
39 . S Y=+Y
40 . I Y=0,'$O(ACCOUNT("YES",0)) D I %=0 S (PRCPFLAG,PRCPEXIT)=1 Q
41 . . S %=$$ALLACCT I %=0 Q
42 . . I %=1 K ACCOUNT("NO") F %=1,2,3,6,8 S ACCOUNT("YES",%)=""
43 . I Y=0 S PRCPFLAG=1 Q
44 . I $D(ACCOUNT("YES",Y)) K ACCOUNT("YES",Y) S ACCOUNT("NO",Y)="" W !?10,"DE-selected !" Q
45 . I $D(ACCOUNT("NO",Y)) K ACCOUNT("NO",Y) S ACCOUNT("YES",Y)="" W !?10,"RE-selected !" Q
46 . S ACCOUNT("YES",Y)="" W !?10,"selected !"
47 I $G(PRCPEXIT) K ACCOUNT
48 K ACCOUNT("NO")
49 W !!,"*** Selected Account Codes: " I '$O(ACCOUNT("YES",0)) W "<<NONE>>" Q
50 S A=0 F S A=$O(ACCOUNT("YES",A)) Q:'A W A W:$O(ACCOUNT("YES",A)) ", " S ACCOUNT(A)=""
51 K ACCOUNT("YES")
52 Q
53 ;
54ALLACCT() ; select all account codes
55 ; returns 1 for yes, 2 for no, 0 for ^
56 S XP="Do you want to select ALL account codes",XH="Enter 'YES' to select all account codes, 'NO' to not select all account codes."
57 W !
58 Q $$YN^PRCPUYN(1)
59 ;
60 ;
61NSNSEL ; start with and end with nsn
62 ; returns prcpstrt and prcpend
63 N PRCPFLAG,X
64 K PRCPSTRT,PRCPEND
65 F D Q:$G(PRCPFLAG)
66 . W !,"START with NSN: FIRST// " R X:DTIME I '$T!(X["^") S PRCPFLAG=1 Q
67 . I X["?" W !?2,"Select the starting NSN value. If you select the default FIRST entry, NULL",!?2,"NSN entries will be selected. If you select 6505, all NSNs starting with",!?2,"6505 will be selected." Q
68 . I X'="",'$$NSNCHECK(X) W !?5,"Invalid NSN format. Format should be in the form 6505-22-333-4444." Q
69 . S PRCPSTRT=X,PRCPFLAG=1
70 I '$D(PRCPSTRT) Q
71 K PRCPFLAG
72 F D Q:$G(PRCPFLAG)
73 . W !," END with NSN: LAST// " R X:DTIME I '$T!(X["^") S PRCPFLAG=1 Q
74 . I X=" " S X=PRCPSTRT W " ",X
75 . I X["?" D Q
76 . . W !?2,"Select the ending NSN value."
77 . . I PRCPSTRT="" Q
78 . . W " If you start with ",PRCPSTRT," and end with ",PRCPSTRT,",",!?2,"you will only select NSNs which begin with ",PRCPSTRT,"."
79 . . W !," Also, enter the <space bar> to set the ending NSN equal to the starting NSN."
80 . I X'="",'$$NSNCHECK(X) W !?5,"Invalid NSN format. Format should be in the form 6505-22-333-4444." Q
81 . I X="" S X="z"
82 . I PRCPSTRT]X W !?4,"Ending NSN must follow starting NSN." Q
83 . S PRCPEND=X,PRCPFLAG=1
84 I '$D(PRCPEND) K PRCPSTRT Q
85 Q
86 ;
87NSNCHECK(V1) ; nsn format check
88 I V1?4N Q 1
89 I V1?4N1"-"2UN Q 1
90 I V1?4N1"-"2UN1"-"3N Q 1
91 I V1?4N1"-"2UN1"-"3N1"-"4N.A Q 1
92 Q 0
Note: See TracBrowser for help on using the repository browser.