- 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 Feb 18, 2025@23:26:59 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
