| 1 | FBUCUTL1 ;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.
 | 
|---|
| 4 | SELECT(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
 | 
|---|
| 11 | SET(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
 | 
|---|
| 18 | DISPX(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
 | 
|---|
| 33 | DISPY ;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)
 | 
|---|
| 43 | END ;kill variables and quit
 | 
|---|
| 44 |  K DIRUT,DTOUT,DUOUT,FBAR,X,Y Q
 | 
|---|
| 45 | CR ;end of page
 | 
|---|
| 46 |  W ! S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) FBOUT=1
 | 
|---|
| 47 |  Q
 | 
|---|