FBUCUTL5 ;ALBISC/TET - UTILITY CONTINUATION (SET DISPLAY) ;6/28/01
;;3.5;FEE BASIS;**32**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
DISP7(IX,IEN,FBO,FB1725R) ;set array for display from file 162.7
;INPUT: order no. of status (FBO), xref (IX) and either veteran or vendor ien (IEN) and optionally mill bill screening criteria (FB1725R)
; FBO is either 0 for all status' for a patient/vendor or
; in string format, delimited by "^" EG: ("10^50^")
; FB1725 = (optional) mill bill screening criteria with value
; "M" for just mill bill claims
; "N" for just non-mill bill claims
; "A" (or null) for all claims
;VARIABLE PL is set to the piece length of order string,
; if fbo = 0 set to 2; if pl>1 status is displayed
; SON = status order number
; FBORDER = specific order from fbo string
; FBMC = master claim ien with Primary or Secondary designation
;OUTPUT: FBAR( array => ien;name(vet or ven)^name(ven or vet)^fee program^date of claim^status (if status not passed - pl'>1)
; FBAR = display count in array;piece positions for display (only if count)
D:$D(XRTL) T0^%ZOSV ;start monitor
K ^TMP("FBAR",$J) N FBAR,FBDA,FBDCT,FBMC,FBOMC,FBORDER,FBSP,FBSET,P,PL,SON,Z S FBDCT=0,FBO=$S('+$G(FBO):$$FBO^FBUCUTL4(),1:FBO),PL=($L(FBO,"^")-1)
S FB1725R=$G(FB1725R) ; optional parameter
S FBOMC=0,FBMC="" F S FBMC=$O(^FB583(IX,IEN,FBMC)) Q:FBMC']"" D
. S FBSET=$S(FBOMC'=+FBMC:1,1:0)
. F P=1:1:PL S SON=$P(FBO,U,P) Q:SON']"" D
. . S FBDA=0 F S FBDA=$O(^FB583(IX,IEN,FBMC,SON,FBDA)) Q:'FBDA I $$MBSCR(FB1725R,FBDA) D DA(FBDA,IX,.FBDCT,FBMC):FBSET,DA1:'FBSET S FBOMC=+FBMC
D FBAR(FBDCT)
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ;stop monitor
Q
DA(FBDA,IX,FBDCT,FBMC,Z) ;get ien in 162.7 and set array; also called from enter tag in fbuclink
;INPUT: FBDA = internal entry number of unauthorized claim
; IX = cross-reference, APMS is from fbuclink
; FBDCT = counter
; FBMC = master claim ien
; Z = (optional) zero node of unauthorized claim
S:$G(Z)']"" Z=$G(^FB583(FBDA,0)) I Z]"" D
.S FBAR=FBDA_";"_$S(IX'="AVMS":($E($$VET^FBUCUTL($P(Z,U,4)),1,12)_U_$E($$VEN^FBUCUTL($P(Z,U,3)),1,12)),1:($E($$VEN^FBUCUTL($P(Z,U,3)),1,12)_U_$E($$VET^FBUCUTL($P(Z,U,4)),1,12)))
.S FBAR=FBAR_U_$E($$PROG^FBUCUTL($P(Z,U,2)),1,12)_U_$$DATX^FBAAUTL($P(Z,U))_U_$E($P($$PTR^FBUCUTL("^FB(162.92,",$P(Z,U,24)),U),1,16)_U_"!"_U_"TREATMENT FROM: "_$$DATX^FBAAUTL(+$P(Z,U,5))_U_"TREATMENT TO: "_$$DATX^FBAAUTL(+$P(Z,U,6))
.I $P(Z,U,20)'=FBDA,+$G(FBMC) S FBAR=FBAR_U_"PRIMARY CLAIM: "_$$DATX^FBAAUTL(+$P($G(^FB583(+FBMC,0)),U))
.S FBDCT=FBDCT+1,^TMP("FBAR",$J,FBDCT)=FBAR
Q
DA1 ;if same set, set node differently
S Z=$G(^FB583(FBDA,0)) I Z]"" D
.S:IX'="AVMS" FBAR=FBDA_";"_$S(FBMC["P":"",1:" ")_$$PAD^FBUCUTL4(12,$E($$VEN^FBUCUTL($P(Z,U,3)),1,12)," ",2)
.S:IX="AVMS" FBAR=FBDA_";"_$S(FBMC["P":"",1:" ")_$$PAD^FBUCUTL4(12,$E($$VET^FBUCUTL($P(Z,U,4)),1,12)," ",2)
.;S FBAR=FBDA_"; "_FBAR
.S FBAR=FBAR_U_" "_$$PAD^FBUCUTL4(12,$E($$PROG^FBUCUTL($P(Z,U,2)),1,12)," ",2)_" "_$$DATX^FBAAUTL($P(Z,U))_" "_$$PAD^FBUCUTL4(16,$E($P($G(^FB(162.92,$$STATUS^FBUCUTL(SON),0)),U),1,16)," ",2)
.S FBAR=FBAR_" <"_$$DATX^FBAAUTL(+$P($G(^FB583(+FBMC,0)),U))_">"
.S FBDCT=FBDCT+1,^TMP("FBAR",$J,FBDCT)=FBAR
Q
FBAR(FBDCT) ;set fbar node, also called from fbuclink
;INPUT: FBDCT = number of entries in global array
;OUTPUT: FBAR = fbar node
; sets tmp("fbar",$j,"fbar")=# entries;piece positions
N E S:$G(FBDCT)']"" FBDCT=0 S FBAR=FBDCT I FBDCT S E="5^20^35^52^63^6^33^57^",FBAR=FBAR_";"_E
S ^TMP("FBAR",$J,"FBAR")=FBAR
Q
DISP8(FBDA) ;set array for display from file 162.8
;INPUT: FBDA = ien of unauthorized claim (file 162.7)
;OUTPUT: FBAR( array => ien of file 162.8;.01 from file 162.93^
K ^TMP("FBAR",$J) N FBAR,FBDCT,FBDT,FBI,Z
S (FBDT,FBDCT)=0 F S FBDT=$O(^FBAA(162.8,"ACD",FBDA,FBDT)) Q:'FBDT D
.S FBI=0 F S FBI=$O(^FBAA(162.8,"ACD",FBDA,FBDT,FBI)) Q:'FBI S Z=$G(^FBAA(162.8,+FBI,0)) I Z]"",'$P(Z,U,5) S FBDCT=FBDCT+1,FBAR=FBI_";"_$P($G(^FB(162.93,+$P(Z,U,3),0)),U) D
..I $P(Z,U,4)]"" S FBAR=FBAR_U_"!"_U_$P(Z,U,4)
..S ^TMP("FBAR",$J,FBDCT)=FBAR
S FBAR=FBDCT I FBDCT S FBAR=FBAR_";5^6^"
S ^TMP("FBAR",$J,"FBAR")=FBAR
Q
DISP9(FN,IG) ;set array for display from files 162.9*
;INPUT: FN = file number
; IG = ignore screen (optional)
;OUTPUT: FBAR( array => ien;.01 from file^
; FBAR = display count in array;piece positions for display (only if count)
K ^TMP("FBAR",$J) N FBAR,FBDA,FBDCT,Z S IG=+$G(IG)
S (FBDA,FBDCT)=0 F S FBDA=$O(^FB(FN,FBDA)) Q:'FBDA S Z=$G(^(FBDA,0)) I Z]"",IG!('IG&($P(Z,U,2))) S FBDCT=FBDCT+1,FBAR=FBDA_";"_$P(Z,U),^TMP("FBAR",$J,FBDCT)=FBAR
S FBAR=FBDCT I FBDCT S FBAR=FBAR_";"_5_U
S ^TMP("FBAR",$J,"FBAR")=FBAR
Q
DISP92 ;display status, in order sequence
;OUTPUT: data in tmp("fbar",$j)
K ^TMP("FBAR",$J) N FBAR,FBDCT,FBI,FBO,Z S (FBDCT,FBO)=0
F S FBO=$O(^FB(162.92,"AO",FBO)) Q:'FBO S FBI=0,FBI=+$O(^FB(162.92,"AO",FBO,0)) I FBI S Z=$G(^FB(162.92,FBI,0)) I Z]"" S FBDCT=FBDCT+1,FBAR=FBI_";"_$P(Z,U),^TMP("FBAR",$J,FBDCT)=FBAR
S FBAR=FBDCT I FBDCT S FBAR=FBAR_";5^"
S ^TMP("FBAR",$J,"FBAR")=FBAR
Q
MBSCR(FB1725R,FBDA) ; Mill Bill Screen
;INPUT: FB1725R - criteria code (M:just mill bill, N:just non-mill bill,
; A:all, null:all)
; FBDA - internal entry number of unauthorized claim
;RETURN: true if claim meets criteria or false if it does not
N FBRET
S FBRET=1 ; initial value
I FB1725R="M",$P($G(^FB583(FBDA,0)),U,28)'=1 S FBRET=0
I FB1725R="N",$P($G(^FB583(FBDA,0)),U,28)=1 S FBRET=0
Q FBRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCUTL5 5777 printed Apr 09, 2024@21:03:07 Page 2
FBUCUTL5 ;ALBISC/TET - UTILITY CONTINUATION (SET DISPLAY) ;6/28/01
+1 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
DISP7(IX,IEN,FBO,FB1725R) ;set array for display from file 162.7
+1 ;INPUT: order no. of status (FBO), xref (IX) and either veteran or vendor ien (IEN) and optionally mill bill screening criteria (FB1725R)
+2 ; FBO is either 0 for all status' for a patient/vendor or
+3 ; in string format, delimited by "^" EG: ("10^50^")
+4 ; FB1725 = (optional) mill bill screening criteria with value
+5 ; "M" for just mill bill claims
+6 ; "N" for just non-mill bill claims
+7 ; "A" (or null) for all claims
+8 ;VARIABLE PL is set to the piece length of order string,
+9 ; if fbo = 0 set to 2; if pl>1 status is displayed
+10 ; SON = status order number
+11 ; FBORDER = specific order from fbo string
+12 ; FBMC = master claim ien with Primary or Secondary designation
+13 ;OUTPUT: FBAR( array => ien;name(vet or ven)^name(ven or vet)^fee program^date of claim^status (if status not passed - pl'>1)
+14 ; FBAR = display count in array;piece positions for display (only if count)
+15 ;start monitor
if $DATA(XRTL)
DO T0^%ZOSV
+16 KILL ^TMP("FBAR",$JOB)
NEW FBAR,FBDA,FBDCT,FBMC,FBOMC,FBORDER,FBSP,FBSET,P,PL,SON,Z
SET FBDCT=0
SET FBO=$SELECT('+$GET(FBO):$$FBO^FBUCUTL4(),1:FBO)
SET PL=($LENGTH(FBO,"^")-1)
+17 ; optional parameter
SET FB1725R=$GET(FB1725R)
+18 SET FBOMC=0
SET FBMC=""
FOR
SET FBMC=$ORDER(^FB583(IX,IEN,FBMC))
if FBMC']""
QUIT
Begin DoDot:1
+19 SET FBSET=$SELECT(FBOMC'=+FBMC:1,1:0)
+20 FOR P=1:1:PL
SET SON=$PIECE(FBO,U,P)
if SON']""
QUIT
Begin DoDot:2
+21 SET FBDA=0
FOR
SET FBDA=$ORDER(^FB583(IX,IEN,FBMC,SON,FBDA))
if 'FBDA
QUIT
IF $$MBSCR(FB1725R,FBDA)
if FBSET
DO DA(FBDA,IX,.FBDCT,FBMC)
if 'FBSET
DO DA1
SET FBOMC=+FBMC
End DoDot:2
End DoDot:1
+22 DO FBAR(FBDCT)
+23 ;stop monitor
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+24 QUIT
DA(FBDA,IX,FBDCT,FBMC,Z) ;get ien in 162.7 and set array; also called from enter tag in fbuclink
+1 ;INPUT: FBDA = internal entry number of unauthorized claim
+2 ; IX = cross-reference, APMS is from fbuclink
+3 ; FBDCT = counter
+4 ; FBMC = master claim ien
+5 ; Z = (optional) zero node of unauthorized claim
+6 if $GET(Z)']""
SET Z=$GET(^FB583(FBDA,0))
IF Z]""
Begin DoDot:1
+7 SET FBAR=FBDA_";"_$SELECT(IX'="AVMS":($EXTRACT($$VET^FBUCUTL($PIECE(Z,U,4)),1,12)_U_$EXTRACT($$VEN^FBUCUTL($PIECE(Z,U,3)),1,12)),1:($EXTRACT($$VEN^FBUCUTL($PIECE(Z,U,3)),1,12)_U_$EXTRACT($$VET^FBUCUTL($PIECE(Z,U,4)),1,12)))
+8 SET FBAR=FBAR_U_$EXTRACT($$PROG^FBUCUTL($PIECE(Z,U,2)),1,12)_U_$$DATX^FBAAUTL($PIECE(Z,U))_U_$EXTRACT(...
... $PIECE($$PTR^FBUCUTL("^FB(162.92,",$PIECE(Z,U,24)),U),1,16)_U_"!"_U_"TREATMENT FROM: "_$$DATX^FBAAUTL(+$PIECE(Z,U,5))_U_"TREATMENT TO: "_$$DATX^FBAAUTL(+$PIECE(Z,U,6))
+9 IF $PIECE(Z,U,20)'=FBDA
IF +$GET(FBMC)
SET FBAR=FBAR_U_"PRIMARY CLAIM: "_$$DATX^FBAAUTL(+$PIECE($GET(^FB583(+FBMC,0)),U))
+10 SET FBDCT=FBDCT+1
SET ^TMP("FBAR",$JOB,FBDCT)=FBAR
End DoDot:1
+11 QUIT
DA1 ;if same set, set node differently
+1 SET Z=$GET(^FB583(FBDA,0))
IF Z]""
Begin DoDot:1
+2 if IX'="AVMS"
SET FBAR=FBDA_";"_$SELECT(FBMC["P":"",1:" ")_$$PAD^FBUCUTL4(12,$EXTRACT($$VEN^FBUCUTL($PIECE(Z,U,3)),1,12)," ",2)
+3 if IX="AVMS"
SET FBAR=FBDA_";"_$SELECT(FBMC["P":"",1:" ")_$$PAD^FBUCUTL4(12,$EXTRACT($$VET^FBUCUTL($PIECE(Z,U,4)),1,12)," ",2)
+4 ;S FBAR=FBDA_"; "_FBAR
+5 SET FBAR=FBAR_U_" "_$$PAD^FBUCUTL4(12,$EXTRACT($$PROG^FBUCUTL($PIECE(Z,U,2)),1,12)," ",2)_" "_$$DATX^FBAAUTL($PIECE(Z,U))_" "_$$PAD^FBUCUTL4(16,$EXTRACT($PIECE($GET(^FB(162.92,$$STATUS^FBUCUTL(SON),0)),U),1,16)," ",2)
+6 SET FBAR=FBAR_" <"_$$DATX^FBAAUTL(+$PIECE($GET(^FB583(+FBMC,0)),U))_">"
+7 SET FBDCT=FBDCT+1
SET ^TMP("FBAR",$JOB,FBDCT)=FBAR
End DoDot:1
+8 QUIT
FBAR(FBDCT) ;set fbar node, also called from fbuclink
+1 ;INPUT: FBDCT = number of entries in global array
+2 ;OUTPUT: FBAR = fbar node
+3 ; sets tmp("fbar",$j,"fbar")=# entries;piece positions
+4 NEW E
if $GET(FBDCT)']""
SET FBDCT=0
SET FBAR=FBDCT
IF FBDCT
SET E="5^20^35^52^63^6^33^57^"
SET FBAR=FBAR_";"_E
+5 SET ^TMP("FBAR",$JOB,"FBAR")=FBAR
+6 QUIT
DISP8(FBDA) ;set array for display from file 162.8
+1 ;INPUT: FBDA = ien of unauthorized claim (file 162.7)
+2 ;OUTPUT: FBAR( array => ien of file 162.8;.01 from file 162.93^
+3 KILL ^TMP("FBAR",$JOB)
NEW FBAR,FBDCT,FBDT,FBI,Z
+4 SET (FBDT,FBDCT)=0
FOR
SET FBDT=$ORDER(^FBAA(162.8,"ACD",FBDA,FBDT))
if 'FBDT
QUIT
Begin DoDot:1
+5 SET FBI=0
FOR
SET FBI=$ORDER(^FBAA(162.8,"ACD",FBDA,FBDT,FBI))
if 'FBI
QUIT
SET Z=$GET(^FBAA(162.8,+FBI,0))
IF Z]""
IF '$PIECE(Z,U,5)
SET FBDCT=FBDCT+1
SET FBAR=FBI_";"_$PIECE($GET(^FB(162.93,+$PIECE(Z,U,3),0)),U)
Begin DoDot:2
+6 IF $PIECE(Z,U,4)]""
SET FBAR=FBAR_U_"!"_U_$PIECE(Z,U,4)
+7 SET ^TMP("FBAR",$JOB,FBDCT)=FBAR
End DoDot:2
End DoDot:1
+8 SET FBAR=FBDCT
IF FBDCT
SET FBAR=FBAR_";5^6^"
+9 SET ^TMP("FBAR",$JOB,"FBAR")=FBAR
+10 QUIT
DISP9(FN,IG) ;set array for display from files 162.9*
+1 ;INPUT: FN = file number
+2 ; IG = ignore screen (optional)
+3 ;OUTPUT: FBAR( array => ien;.01 from file^
+4 ; FBAR = display count in array;piece positions for display (only if count)
+5 KILL ^TMP("FBAR",$JOB)
NEW FBAR,FBDA,FBDCT,Z
SET IG=+$GET(IG)
+6 SET (FBDA,FBDCT)=0
FOR
SET FBDA=$ORDER(^FB(FN,FBDA))
if 'FBDA
QUIT
SET Z=$GET(^(FBDA,0))
IF Z]""
IF IG!('IG&($PIECE(Z,U,2)))
SET FBDCT=FBDCT+1
SET FBAR=FBDA_";"_$PIECE(Z,U)
SET ^TMP("FBAR",$JOB,FBDCT)=FBAR
+7 SET FBAR=FBDCT
IF FBDCT
SET FBAR=FBAR_";"_5_U
+8 SET ^TMP("FBAR",$JOB,"FBAR")=FBAR
+9 QUIT
DISP92 ;display status, in order sequence
+1 ;OUTPUT: data in tmp("fbar",$j)
+2 KILL ^TMP("FBAR",$JOB)
NEW FBAR,FBDCT,FBI,FBO,Z
SET (FBDCT,FBO)=0
+3 FOR
SET FBO=$ORDER(^FB(162.92,"AO",FBO))
if 'FBO
QUIT
SET FBI=0
SET FBI=+$ORDER(^FB(162.92,"AO",FBO,0))
IF FBI
SET Z=$GET(^FB(162.92,FBI,0))
IF Z]""
SET FBDCT=FBDCT+1
SET FBAR=FBI_";"_$PIECE(Z,U)
SET ^TMP("FBAR",$JOB,FBDCT)=FBAR
+4 SET FBAR=FBDCT
IF FBDCT
SET FBAR=FBAR_";5^"
+5 SET ^TMP("FBAR",$JOB,"FBAR")=FBAR
+6 QUIT
MBSCR(FB1725R,FBDA) ; Mill Bill Screen
+1 ;INPUT: FB1725R - criteria code (M:just mill bill, N:just non-mill bill,
+2 ; A:all, null:all)
+3 ; FBDA - internal entry number of unauthorized claim
+4 ;RETURN: true if claim meets criteria or false if it does not
+5 NEW FBRET
+6 ; initial value
SET FBRET=1
+7 IF FB1725R="M"
IF $PIECE($GET(^FB583(FBDA,0)),U,28)'=1
SET FBRET=0
+8 IF FB1725R="N"
IF $PIECE($GET(^FB583(FBDA,0)),U,28)=1
SET FBRET=0
+9 QUIT FBRET
