48 lines
3.4 KiB
Mathematica
48 lines
3.4 KiB
Mathematica
FBUCUTL1 ;ALBISC/TET - UNAUTHORIZED CLAIMS UTILITY (CONT'D) ;5/19/93 15:35
|
|
;;3.5;FEE BASIS;;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
SELECT(I,DIRA) ;select from displayed list
|
|
;INPUT: FBAR and FBAR array - choices from which to select
|
|
; DIRA - optional, DIR("A")/ FBOUT = 0
|
|
;OUTPUT: FBARY and FBARY array - selection
|
|
; or FBOUT = 1 if no selection or time out or up arrow
|
|
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)
|
|
Q
|
|
SET(FBY) ;set up tmp global
|
|
;INPUT: FBY = user selection from list call
|
|
;OUTPUT: TMP(FBARY array = user selection array
|
|
; FBARY = counter;piece location node
|
|
N FBDCT,I
|
|
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)))
|
|
Q
|
|
DISPX(DISP,SCR) ;display array for user selection
|
|
;INPUT: DISP=0 to display only; make no selection
|
|
; =1 to display prior to selection only
|
|
; =2 to display what was selected in addition to what to select
|
|
; SCR = flag if data was screened; used in message if nothing found <optional>
|
|
; TMP("FBAR",$J,"FBAR")=count;piece position
|
|
; TMP("FBAR"=display global array of what to select
|
|
;OUTPUT: FBOUT = 0 if ok, 1 if time out or quit or no selection
|
|
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
|
|
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
|
|
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"))
|
|
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
|
|
.I ($Y+5)>IOSL D SELECT(FBCT,FBA):FBCT&(DISP),CR:FBCT&('DISP) Q:FBOUT!(+FBARY&(DISP>0)) W @IOF,!
|
|
.S FBCT=FBCT+1,FBNODE=$G(^TMP("FBAR",$J,I)) D LINE^FBUCUTL4(FBNODE,FBCT,$L(FBNODE,"^"),FBW)
|
|
Q:FBOUT W:'DISP ! I DISP,'+FBARY S FBCT=$S(FBCT:FBCT,1:+FBAR) D SELECT(FBCT) Q:FBOUT
|
|
DISPY ;display user selection
|
|
;INPUT: FBARY( - user selection array
|
|
; FBARY - count in array;position locations (delimitted by ^)
|
|
; FBP - number or '^' piece delimiters
|
|
; FBW - write positions, delimited by '^'
|
|
;OUTPUT: FBOUT - 1 if time out or up arrow, 0 if OK
|
|
S:'$D(FBOUT) FBOUT=0 S FBARY=$G(^TMP("FBARY",$J,"FBARY")) I $S('+FBARY:1,DISP'=2:1,1:0) G END
|
|
N FBNODE,I I '$G(FBPL)!('$G(FBW)) N FBPL,FBW D PARSE^FBUCUTL4(FBARY)
|
|
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 !
|
|
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)
|
|
END ;kill variables and quit
|
|
K DIRUT,DTOUT,DUOUT,FBAR,X,Y Q
|
|
CR ;end of page
|
|
W ! S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1
|
|
Q
|