- FBUCOUT1 ;ALBISC/TET - OUTPUTS cont'd ;6/27/2001
- ;;3.5;FEE BASIS;**32**;JAN 30, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ONE ;display/print all claims for one vendor/veteran/other party
- ;sort by treatment from/to dates, group by master claim
- ;sort by vendor if vet or other selected, otherwise veteran
- ;'*' denotes secondary claim
- N FBI,FBIEN,FBIX,FBMC,FBOIEN,FBPTR,FBSORT,FBZ S (FBVEN,FBVET,FBOTH)=""
- D IEN^FBUCUTL3 G END:'FBIEN
- ; ask if report for just mill-bill (1725) or just non-mill bill claims
- S FB1725R=$$ASKMB^FBUCUTL9 I FB1725R="" G END
- I FBIX="AOMS" S FBOIEN=FBIEN,FBOTH=$P($G(^VA(200,FBOIEN,0)),U),FBIEN=+$P($$FBZ^FBUCUTL(+$O(^FB583(FBIX,FBOIEN,0))),U,4)
- S:FBIX'="AVMS" FBVET=$P($G(^DPT(FBIEN,0)),U) S:FBIX="AVMS" FBVEN=$P($G(^FBAAV(FBIEN,0)),U)
- Q ;que to print
- S:FBIX="AOMS" FBIEN=FBOIEN S VAR="FBIX^FBIEN^FBVEN^FBVET^FBOTH^FB1725R",VAL=VAR,PGM="SORT^FBUCOUT1" D ZIS^FBAAUTL G:FBPOP END
- SORT ;sort all claims output
- U IO K ^TMP("FB",$J) N FBI,FBMC,FBZ
- S FBMC="" F S FBMC=$O(^FB583(FBIX,FBIEN,FBMC)) Q:FBMC']"" S FBI=0 F S FBI=$O(^FB583("AMC",+FBMC,FBI)) Q:'FBI S FBZ=$G(^FB583(FBI,0)) I FBZ]"" D
- .; if user requested just mill-bill (1725) or non-mill bill claims then
- .; check claim and skip when appropriate
- .Q:$S(FB1725R="M"&'+$P(FBZ,U,28):1,FB1725R="N"&+$P(FBZ,U,28):1,1:0)
- .N FBPTR,FBSORT,NODE S FBPTR=$S(FBIX="AVMS":$P(FBZ,U,4),1:$P(FBZ,U,3))
- .S FBSORT=$P($$PTR^FBUCUTL($S(FBIX="AVMS":"^DPT(",1:"^FBAAV("),FBPTR),U) I FBIX="AVMS" S FBSORT=$E(FBSORT,1,30)
- .S NODE=$E($P($$PROG^FBUCUTL(+$P(FBZ,U,2)),U),1,15)_U_$E($P($$PTR^FBUCUTL("^FB(162.92,",$P(FBZ,U,24)),U),1,20) I "^40^70^90^"[$$ORDER^FBUCUTL($P(FBZ,U,24)) S NODE=NODE_U_$$CODE^FBUCOUT($P(FBZ,U,11))
- .S ^TMP("FB",$J,+$P(FBZ,U,5)_";"_+$P(FBZ,U,6),+FBMC_$S(+FBMC=FBI:"P",1:"S")_";"_FBI,$S(+FBMC=FBI:"",1:" *")_FBSORT_";"_FBPTR)=NODE
- .S FBMC=+FBMC_"z"
- PRINT ;print all claims output
- N DIRUT,DTOUT,DUTOUT,FBCRT,FBDASH,FBDT,FBHDR,FBMC,FBN,FBNODE,FBOMC,FBOUT,FBPG
- S FBHDR=$S(FBIX="AVMS":"VENDOR: "_FBVEN,FBIX="APMS":"VETERAN: "_FBVET,1:"OTHER PARTY: "_FBOTH),FBPG=0,FBCRT=$S($E(IOST,1,2)="C-":1,1:0),FBOUT=0,$P(FBDASH,"=",80)="" D PAGE
- S FBOMC=0,FBDT=""
- F S FBDT=$O(^TMP("FB",$J,FBDT)) Q:FBDT']""!(FBOUT) S FBMC="" F S FBMC=$O(^TMP("FB",$J,FBDT,FBMC)) Q:FBMC']"" W:+FBOMC'=+FBMC !! S FBOMC=FBMC D Q:FBOUT
- .S FBN="" F S FBN=$O(^TMP("FB",$J,FBDT,FBMC,FBN)) Q:FBN']"" S FBNODE=$G(^TMP("FB",$J,FBDT,FBMC,FBN)) D Q:FBOUT
- ..I IOSL<($Y+5) D PAGE Q:FBOUT
- ..W !,$P(FBN,";"),?34,$P(FBNODE,U),?53,$P(FBNODE,U,2),?75,$P(FBNODE,U,3)
- ..W !?3,"Treatment From: ",$$DATX^FBAAUTL($P(FBDT,";")),?29,"Treatment To: ",$$DATX^FBAAUTL($P(FBDT,";",2))
- ..I FBIX="AOMS" W ?54,"VETERAN: ",$E($$VET^FBUCUTL(+$P($$FBZ^FBUCUTL(+$P(FBMC,";",2)),U,4)),1,16)
- END ;kill variables,tmp global and quit
- K FBIEN,FBIX,FBOTH,FBPOP,FBVEN,FBVET,PGM,POP,VAL,VAR,^TMP("FB",$J),FB1725R
- D CLOSE^FBAAUTL
- Q
- PAGE ;write new page
- D:FBCRT&(FBPG>0) CR Q:FBOUT
- HDR W:FBCRT!(FBPG>0) @IOF S FBPG=FBPG+1
- W !,FBHDR,!?70,"Page: ",FBPG,!,$S(FBIX="AVMS":"Veteran",1:"Vendor"),?34,"Fee Program",?53,"Status",?75,"Code",!,FBDASH
- Q
- CR ;ask end of page prompt
- ;OUTPUT: FBOUT is set if time out or up arrow out
- 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[HFBUCOUT1 3309 printed Mar 13, 2025@21:05:18 Page 2
- FBUCOUT1 ;ALBISC/TET - OUTPUTS cont'd ;6/27/2001
- +1 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ONE ;display/print all claims for one vendor/veteran/other party
- +1 ;sort by treatment from/to dates, group by master claim
- +2 ;sort by vendor if vet or other selected, otherwise veteran
- +3 ;'*' denotes secondary claim
- +4 NEW FBI,FBIEN,FBIX,FBMC,FBOIEN,FBPTR,FBSORT,FBZ
- SET (FBVEN,FBVET,FBOTH)=""
- +5 DO IEN^FBUCUTL3
- if 'FBIEN
- GOTO END
- +6 ; ask if report for just mill-bill (1725) or just non-mill bill claims
- +7 SET FB1725R=$$ASKMB^FBUCUTL9
- IF FB1725R=""
- GOTO END
- +8 IF FBIX="AOMS"
- SET FBOIEN=FBIEN
- SET FBOTH=$PIECE($GET(^VA(200,FBOIEN,0)),U)
- SET FBIEN=+$PIECE($$FBZ^FBUCUTL(+$ORDER(^FB583(FBIX,FBOIEN,0))),U,4)
- +9 if FBIX'="AVMS"
- SET FBVET=$PIECE($GET(^DPT(FBIEN,0)),U)
- if FBIX="AVMS"
- SET FBVEN=$PIECE($GET(^FBAAV(FBIEN,0)),U)
- Q ;que to print
- +1 if FBIX="AOMS"
- SET FBIEN=FBOIEN
- SET VAR="FBIX^FBIEN^FBVEN^FBVET^FBOTH^FB1725R"
- SET VAL=VAR
- SET PGM="SORT^FBUCOUT1"
- DO ZIS^FBAAUTL
- if FBPOP
- GOTO END
- SORT ;sort all claims output
- +1 USE IO
- KILL ^TMP("FB",$JOB)
- NEW FBI,FBMC,FBZ
- +2 SET FBMC=""
- FOR
- SET FBMC=$ORDER(^FB583(FBIX,FBIEN,FBMC))
- if FBMC']""
- QUIT
- SET FBI=0
- FOR
- SET FBI=$ORDER(^FB583("AMC",+FBMC,FBI))
- if 'FBI
- QUIT
- SET FBZ=$GET(^FB583(FBI,0))
- IF FBZ]""
- Begin DoDot:1
- +3 ; if user requested just mill-bill (1725) or non-mill bill claims then
- +4 ; check claim and skip when appropriate
- +5 if $SELECT(FB1725R="M"&'+$PIECE(FBZ,U,28)
- QUIT
- +6 NEW FBPTR,FBSORT,NODE
- SET FBPTR=$SELECT(FBIX="AVMS":$PIECE(FBZ,U,4),1:$PIECE(FBZ,U,3))
- +7 SET FBSORT=$PIECE($$PTR^FBUCUTL($SELECT(FBIX="AVMS":"^DPT(",1:"^FBAAV("),FBPTR),U)
- IF FBIX="AVMS"
- SET FBSORT=$EXTRACT(FBSORT,1,30)
- +8 SET NODE=$EXTRACT($PIECE($$PROG^FBUCUTL(+$PIECE(FBZ,U,2)),U),1,15)_U_$EXTRACT($PIECE($$PTR^FBUCUTL("^FB(162.92,",$PIECE(FBZ,U,24)),U),1,20)
- IF "^40^70^90^"[$$ORDER^FBUCUTL($PIECE(FBZ,U,24))
- SET NODE=NODE_U_$$CODE^FBUCOUT($PIECE(FBZ,U,11))
- +9 SET ^TMP("FB",$JOB,+$PIECE(FBZ,U,5)_";"_+$PIECE(FBZ,U,6),+FBMC_$SELECT(+FBMC=FBI:"P",1:"S")_";"_FBI,$SELECT(+FBMC=FBI:"",1:" *")_FBSORT_";"_FBPTR)=NODE
- +10 SET FBMC=+FBMC_"z"
- End DoDot:1
- PRINT ;print all claims output
- +1 NEW DIRUT,DTOUT,DUTOUT,FBCRT,FBDASH,FBDT,FBHDR,FBMC,FBN,FBNODE,FBOMC,FBOUT,FBPG
- +2 SET FBHDR=$SELECT(FBIX="AVMS":"VENDOR: "_FBVEN,FBIX="APMS":"VETERAN: "_FBVET,1:"OTHER PARTY: "_FBOTH)
- SET FBPG=0
- SET FBCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
- SET FBOUT=0
- SET $PIECE(FBDASH,"=",80)=""
- DO PAGE
- +3 SET FBOMC=0
- SET FBDT=""
- +4 FOR
- SET FBDT=$ORDER(^TMP("FB",$JOB,FBDT))
- if FBDT']""!(FBOUT)
- QUIT
- SET FBMC=""
- FOR
- SET FBMC=$ORDER(^TMP("FB",$JOB,FBDT,FBMC))
- if FBMC']""
- QUIT
- if +FBOMC'=+FBMC
- WRITE !!
- SET FBOMC=FBMC
- Begin DoDot:1
- +5 SET FBN=""
- FOR
- SET FBN=$ORDER(^TMP("FB",$JOB,FBDT,FBMC,FBN))
- if FBN']""
- QUIT
- SET FBNODE=$GET(^TMP("FB",$JOB,FBDT,FBMC,FBN))
- Begin DoDot:2
- +6 IF IOSL<($Y+5)
- DO PAGE
- if FBOUT
- QUIT
- +7 WRITE !,$PIECE(FBN,";"),?34,$PIECE(FBNODE,U),?53,$PIECE(FBNODE,U,2),?75,$PIECE(FBNODE,U,3)
- +8 WRITE !?3,"Treatment From: ",$$DATX^FBAAUTL($PIECE(FBDT,";")),?29,"Treatment To: ",$$DATX^FBAAUTL($PIECE(FBDT,";",2))
- +9 IF FBIX="AOMS"
- WRITE ?54,"VETERAN: ",$EXTRACT($$VET^FBUCUTL(+$PIECE($$FBZ^FBUCUTL(+$PIECE(FBMC,";",2)),U,4)),1,16)
- End DoDot:2
- if FBOUT
- QUIT
- End DoDot:1
- if FBOUT
- QUIT
- END ;kill variables,tmp global and quit
- +1 KILL FBIEN,FBIX,FBOTH,FBPOP,FBVEN,FBVET,PGM,POP,VAL,VAR,^TMP("FB",$JOB),FB1725R
- +2 DO CLOSE^FBAAUTL
- +3 QUIT
- PAGE ;write new page
- +1 if FBCRT&(FBPG>0)
- DO CR
- if FBOUT
- QUIT
- HDR if FBCRT!(FBPG>0)
- WRITE @IOF
- SET FBPG=FBPG+1
- +1 WRITE !,FBHDR,!?70,"Page: ",FBPG,!,$SELECT(FBIX="AVMS":"Veteran",1:"Vendor"),?34,"Fee Program",?53,"Status",?75,"Code",!,FBDASH
- +2 QUIT
- CR ;ask end of page prompt
- +1 ;OUTPUT: FBOUT is set if time out or up arrow out
- +2 WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- SET FBOUT=1
- +3 QUIT