Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPURS0

PRCPURS0.m

Go to the documentation of this file.
  1. PRCPURS0 ;WISC/RFJ-ask sort, select acct, select nsn, select item ;17 May 93
  1. ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. SORTBY() ; select type of sort
  1. N DIR,X,Y
  1. 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
  1. Q +Y
  1. ;
  1. ;
  1. SUMMARY() ; print summary only
  1. N %,X
  1. K X S X(1)="Display Summary or ALL Data." D DISPLAY^PRCPUX2(2,40,.X)
  1. S XP="Do you want to print a summary only",XH="Enter 'YES' to print a summary, 'NO' to print entire report, '^' to exit."
  1. S %=$$YN^PRCPUYN(1)
  1. Q $S(%=1:1,%=2:0,1:-1)
  1. ;
  1. ;
  1. ACCTSEL ; pick account codes or all
  1. ; returns array of accounts selected
  1. N %,A,DIR,DIRUT,DTOUT,DUOUT,PRCPEXIT,PRCPFLAG,PRCPLINE,X,Y
  1. S PRCPLINE="",$P(PRCPLINE,"-",78)=""
  1. K ACCOUNT
  1. F %=1,2,3,6,8 S ACCOUNT("NO",%)=""
  1. F D I $G(PRCPFLAG) Q
  1. . W !
  1. . I $O(ACCOUNT("YES",0)) D
  1. . . W !?2,PRCPLINE,!?2,"| Currently selected account codes : "
  1. . . S A=0 F S A=$O(ACCOUNT("YES",A)) Q:'A W A W:$O(ACCOUNT("YES",A)) ", "
  1. . . W ?78,"|",!?2,"| You can DE-select one of the above account codes by reselecting it.",?78,"|"
  1. . I $O(ACCOUNT("NO",0)) D
  1. . . W !?2,PRCPLINE,!?2,"| Currently DE-selected account codes: "
  1. . . S A=0 F S A=$O(ACCOUNT("NO",A)) Q:'A W A W:$O(ACCOUNT("NO",A)) ", "
  1. . . W ?78,"|",!?2,"| You can RE-select one of the above account codes by reselecting it.",?78,"|"
  1. . W !?2,PRCPLINE
  1. . 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
  1. . S Y=+Y
  1. . I Y=0,'$O(ACCOUNT("YES",0)) D I %=0 S (PRCPFLAG,PRCPEXIT)=1 Q
  1. . . S %=$$ALLACCT I %=0 Q
  1. . . I %=1 K ACCOUNT("NO") F %=1,2,3,6,8 S ACCOUNT("YES",%)=""
  1. . I Y=0 S PRCPFLAG=1 Q
  1. . I $D(ACCOUNT("YES",Y)) K ACCOUNT("YES",Y) S ACCOUNT("NO",Y)="" W !?10,"DE-selected !" Q
  1. . I $D(ACCOUNT("NO",Y)) K ACCOUNT("NO",Y) S ACCOUNT("YES",Y)="" W !?10,"RE-selected !" Q
  1. . S ACCOUNT("YES",Y)="" W !?10,"selected !"
  1. I $G(PRCPEXIT) K ACCOUNT
  1. K ACCOUNT("NO")
  1. W !!,"*** Selected Account Codes: " I '$O(ACCOUNT("YES",0)) W "<<NONE>>" Q
  1. S A=0 F S A=$O(ACCOUNT("YES",A)) Q:'A W A W:$O(ACCOUNT("YES",A)) ", " S ACCOUNT(A)=""
  1. K ACCOUNT("YES")
  1. Q
  1. ;
  1. ALLACCT() ; select all account codes
  1. ; returns 1 for yes, 2 for no, 0 for ^
  1. 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."
  1. W !
  1. Q $$YN^PRCPUYN(1)
  1. ;
  1. ;
  1. NSNSEL ; start with and end with nsn
  1. ; returns prcpstrt and prcpend
  1. N PRCPFLAG,X
  1. K PRCPSTRT,PRCPEND
  1. F D Q:$G(PRCPFLAG)
  1. . W !,"START with NSN: FIRST// " R X:DTIME I '$T!(X["^") S PRCPFLAG=1 Q
  1. . 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
  1. . I X'="",'$$NSNCHECK(X) W !?5,"Invalid NSN format. Format should be in the form 6505-22-333-4444." Q
  1. . S PRCPSTRT=X,PRCPFLAG=1
  1. I '$D(PRCPSTRT) Q
  1. K PRCPFLAG
  1. F D Q:$G(PRCPFLAG)
  1. . W !," END with NSN: LAST// " R X:DTIME I '$T!(X["^") S PRCPFLAG=1 Q
  1. . I X=" " S X=PRCPSTRT W " ",X
  1. . I X["?" D Q
  1. . . W !?2,"Select the ending NSN value."
  1. . . I PRCPSTRT="" Q
  1. . . W " If you start with ",PRCPSTRT," and end with ",PRCPSTRT,",",!?2,"you will only select NSNs which begin with ",PRCPSTRT,"."
  1. . . W !," Also, enter the <space bar> to set the ending NSN equal to the starting NSN."
  1. . I X'="",'$$NSNCHECK(X) W !?5,"Invalid NSN format. Format should be in the form 6505-22-333-4444." Q
  1. . I X="" S X="z"
  1. . I PRCPSTRT]X W !?4,"Ending NSN must follow starting NSN." Q
  1. . S PRCPEND=X,PRCPFLAG=1
  1. I '$D(PRCPEND) K PRCPSTRT Q
  1. Q
  1. ;
  1. NSNCHECK(V1) ; nsn format check
  1. I V1?4N Q 1
  1. I V1?4N1"-"2UN Q 1
  1. I V1?4N1"-"2UN1"-"3N Q 1
  1. I V1?4N1"-"2UN1"-"3N1"-"4N.A Q 1
  1. Q 0