source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCUTL1.m@ 792

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1FBUCUTL1 ;ALBISC/TET - UNAUTHORIZED CLAIMS UTILITY (CONT'D) ;5/19/93 15:35
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4SELECT(I,DIRA) ;select from displayed list
5 ;INPUT: FBAR and FBAR array - choices from which to select
6 ; DIRA - optional, DIR("A")/ FBOUT = 0
7 ;OUTPUT: FBARY and FBARY array - selection
8 ; or FBOUT = 1 if no selection or time out or up arrow
9 Q:'+$G(FBAR) N FBDCT S DIR(0)="LO^1:"_I_"^K:X#1 X",DIR("A")=$S('$D(DIRA):"Enter selection",DIRA']"":"Enter selection",1:DIRA) W ! D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1 Q:FBOUT!('Y) I +Y S FBARY(0)=Y D SET(FBARY(0)) ;K FBARY(0)
10 Q
11SET(FBY) ;set up tmp global
12 ;INPUT: FBY = user selection from list call
13 ;OUTPUT: TMP(FBARY array = user selection array
14 ; FBARY = counter;piece location node
15 N FBDCT,I
16 S FBDCT=($L(FBY,","))-1,FBARY=FBDCT,$P(FBARY,";",2)=$S($G(FBAR)]"":$P(FBAR,";",2),1:""),^TMP("FBARY",$J,"FBARY")=FBARY F I=1:1:FBDCT I '($P(FBY,",",I)#1) S ^TMP("FBARY",$J,$P(FBY,",",I))=$G(^TMP("FBAR",$J,$P(FBY,",",I)))
17 Q
18DISPX(DISP,SCR) ;display array for user selection
19 ;INPUT: DISP=0 to display only; make no selection
20 ; =1 to display prior to selection only
21 ; =2 to display what was selected in addition to what to select
22 ; SCR = flag if data was screened; used in message if nothing found <optional>
23 ; TMP("FBAR",$J,"FBAR")=count;piece position
24 ; TMP("FBAR"=display global array of what to select
25 ;OUTPUT: FBOUT = 0 if ok, 1 if time out or quit or no selection
26 K ^TMP("FBARY") S:'$D(FBOUT) FBOUT=0 G:FBOUT END S DISP=+$G(DISP),SCR=+$G(SCR) N I,P,FBA,FBAR,FBCT,FBNODE,FBPL,FBW S (FBCT,FBARY)=0 S:$G(DISP)']"" DISP=0
27 S FBAR=$G(^TMP("FBAR",$J,"FBAR")) I '+FBAR W ! W:'SCR "No data on file." W:SCR "Nothing found which meets the criteria." W ! H 2 G END
28 D PARSE^FBUCUTL4(FBAR) ;I +FBAR=1 S FBARY(0)=1 D SET(FBARY(0)) ;S ^TMP("FBARY",$J,1)=^TMP("FBAR",$J,1),^TMP("FBARY",$J,"FBARY")=FBAR,FBARY=$G(^TMP("FBARY",$J,"FBARY"))
29 I +FBAR!(DISP=0) W:DISP>0 @IOF W:DISP>0 !?3,"Select from the following:",!! S FBA="Enter RETURN for more, or Select",I=0 F S I=$O(^TMP("FBAR",$J,I)) Q:'I!(FBARY&(DISP>0)) D G:FBOUT END
30 .I ($Y+5)>IOSL D SELECT(FBCT,FBA):FBCT&(DISP),CR:FBCT&('DISP) Q:FBOUT!(+FBARY&(DISP>0)) W @IOF,!
31 .S FBCT=FBCT+1,FBNODE=$G(^TMP("FBAR",$J,I)) D LINE^FBUCUTL4(FBNODE,FBCT,$L(FBNODE,"^"),FBW)
32 Q:FBOUT W:'DISP ! I DISP,'+FBARY S FBCT=$S(FBCT:FBCT,1:+FBAR) D SELECT(FBCT) Q:FBOUT
33DISPY ;display user selection
34 ;INPUT: FBARY( - user selection array
35 ; FBARY - count in array;position locations (delimitted by ^)
36 ; FBP - number or '^' piece delimiters
37 ; FBW - write positions, delimited by '^'
38 ;OUTPUT: FBOUT - 1 if time out or up arrow, 0 if OK
39 S:'$D(FBOUT) FBOUT=0 S FBARY=$G(^TMP("FBARY",$J,"FBARY")) I $S('+FBARY:1,DISP'=2:1,1:0) G END
40 N FBNODE,I I '$G(FBPL)!('$G(FBW)) N FBPL,FBW D PARSE^FBUCUTL4(FBARY)
41 W ! S I=0 F S I=$O(^TMP("FBARY",$J,I)) Q:'I S FBNODE=$G(^(I)) D LINE^FBUCUTL4(FBNODE,I,FBPL,FBW) ;W ! F P=1:1:FBP W ?($P(FBW,U,P)),$P($P(FBARY(I),";",2),U,P) W:P=5 !
42 I +FBARY S DIR(0)="Y",DIR("A")="You have selected the above. OK",DIR("B")="YES" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1 I 'Y,'FBOUT D DISPX(DISP)
43END ;kill variables and quit
44 K DIRUT,DTOUT,DUOUT,FBAR,X,Y Q
45CR ;end of page
46 W ! S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1
47 Q
Note: See TracBrowser for help on using the repository browser.