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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCUTL1 3479 printed Nov 22, 2024@17:10:40 Page 2
FBUCUTL1 ;ALBISC/TET - UNAUTHORIZED CLAIMS UTILITY (CONT'D) ;5/19/93 15:35
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
SELECT(I,DIRA) ;select from displayed list
+1 ;INPUT: FBAR and FBAR array - choices from which to select
+2 ; DIRA - optional, DIR("A")/ FBOUT = 0
+3 ;OUTPUT: FBARY and FBARY array - selection
+4 ; or FBOUT = 1 if no selection or time out or up arrow
+5 ;K FBARY(0)
if '+$GET(FBAR)
QUIT
NEW FBDCT
SET DIR(0)="LO^1:"_I_"^K:X#1 X"
SET DIR("A")=$SELECT('$DATA(DIRA):"Enter selection",DIRA']"":"Enter selection",1:DIRA)
WRITE !
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET FBOUT=1
if FBOUT!('Y)
QUIT
IF +Y
SET FBARY(0)=Y
DO SET(FBARY(0))
+6 QUIT
SET(FBY) ;set up tmp global
+1 ;INPUT: FBY = user selection from list call
+2 ;OUTPUT: TMP(FBARY array = user selection array
+3 ; FBARY = counter;piece location node
+4 NEW FBDCT,I
+5 SET FBDCT=($LENGTH(FBY,","))-1
SET FBARY=FBDCT
SET $PIECE(FBARY,";",2)=$SELECT($GET(FBAR)]"":$PIECE(FBAR,";",2),1:"")
SET ^TMP("FBARY",$JOB,"FBARY")=FBARY
FOR I=1:1:FBDCT
IF '($PIECE(FBY,",",I)#1)
SET ^TMP("FBARY",$JOB,$PIECE(FBY,",",I))=$GET(^TMP("FBAR",$JOB,$PIECE(FBY,",",I)))
+6 QUIT
DISPX(DISP,SCR) ;display array for user selection
+1 ;INPUT: DISP=0 to display only; make no selection
+2 ; =1 to display prior to selection only
+3 ; =2 to display what was selected in addition to what to select
+4 ; SCR = flag if data was screened; used in message if nothing found <optional>
+5 ; TMP("FBAR",$J,"FBAR")=count;piece position
+6 ; TMP("FBAR"=display global array of what to select
+7 ;OUTPUT: FBOUT = 0 if ok, 1 if time out or quit or no selection
+8 KILL ^TMP("FBARY")
if '$DATA(FBOUT)
SET FBOUT=0
if FBOUT
GOTO END
SET DISP=+$GET(DISP)
SET SCR=+$GET(SCR)
NEW I,P,FBA,FBAR,FBCT,FBNODE,FBPL,FBW
SET (FBCT,FBARY)=0
if $GET(DISP)']""
SET DISP=0
+9 SET FBAR=$GET(^TMP("FBAR",$JOB,"FBAR"))
IF '+FBAR
WRITE !
if 'SCR
WRITE "No data on file."
if SCR
WRITE "Nothing found which meets the criteria."
WRITE !
HANG 2
GOTO END
+10 ;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"))
DO PARSE^FBUCUTL4(FBAR)
+11 IF +FBAR!(DISP=0)
if DISP>0
WRITE @IOF
if DISP>0
WRITE !?3,"Select from the following:",!!
SET FBA="Enter RETURN for more, or Select"
SET I=0
FOR
SET I=$ORDER(^TMP("FBAR",$JOB,I))
if 'I!(FBARY&(DISP>0))
QUIT
Begin DoDot:1
+12 IF ($Y+5)>IOSL
if FBCT&(DISP)
DO SELECT(FBCT,FBA)
if FBCT&('DISP)
DO CR
if FBOUT!(+FBARY&(DISP>0))
QUIT
WRITE @IOF,!
+13 SET FBCT=FBCT+1
SET FBNODE=$GET(^TMP("FBAR",$JOB,I))
DO LINE^FBUCUTL4(FBNODE,FBCT,$LENGTH(FBNODE,"^"),FBW)
End DoDot:1
if FBOUT
GOTO END
+14 if FBOUT
QUIT
if 'DISP
WRITE !
IF DISP
IF '+FBARY
SET FBCT=$SELECT(FBCT:FBCT,1:+FBAR)
DO SELECT(FBCT)
if FBOUT
QUIT
DISPY ;display user selection
+1 ;INPUT: FBARY( - user selection array
+2 ; FBARY - count in array;position locations (delimitted by ^)
+3 ; FBP - number or '^' piece delimiters
+4 ; FBW - write positions, delimited by '^'
+5 ;OUTPUT: FBOUT - 1 if time out or up arrow, 0 if OK
+6 if '$DATA(FBOUT)
SET FBOUT=0
SET FBARY=$GET(^TMP("FBARY",$JOB,"FBARY"))
IF $SELECT('+FBARY:1,DISP'=2:1,1:0)
GOTO END
+7 NEW FBNODE,I
IF '$GET(FBPL)!('$GET(FBW))
NEW FBPL,FBW
DO PARSE^FBUCUTL4(FBARY)
+8 ;W ! F P=1:1:FBP W ?($P(FBW,U,P)),$P($P(FBARY(I),";",2),U,P) W:P=5 !
WRITE !
SET I=0
FOR
SET I=$ORDER(^TMP("FBARY",$JOB,I))
if 'I
QUIT
SET FBNODE=$GET(^(I))
DO LINE^FBUCUTL4(FBNODE,I,FBPL,FBW)
+9 IF +FBARY
SET DIR(0)="Y"
SET DIR("A")="You have selected the above. OK"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET FBOUT=1
IF 'Y
IF 'FBOUT
DO DISPX(DISP)
END ;kill variables and quit
+1 KILL DIRUT,DTOUT,DUOUT,FBAR,X,Y
QUIT
CR ;end of page
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET FBOUT=1
+2 QUIT
