- FBPAID3B ;DSS/SCR - Utilities to support FEE BASIS PAID TO IB Process ;3/28/1012
- ;;3.5;FEE BASIS;**135**;JAN 30, 1995;Build 3
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- Q
- ;
- EPFBPRV() ;EP FROM OPTION [FB PROVIDER TO IB]
- ;
- ;REPORTING OPTION FOR FB PAID TO IB AUTOMATIC INTERFACE TO IB NON/OTHER VA BILLING PROVIDER FILE
- ;
- N DUOUT,DIRUT,DTOUT,FBQUIT,DIR,FBFROM,FBTO,FBDATE,FBIEN,FBNODE,FBPROG,FBNPI,FBNPISRT,Y,X1,X2,X,FBQUIT1
- N FBTODATE
- ;
- S FBQUIT1=0
- F Q:FBQUIT1 D
- .K ^TMP($J,"FBPAID3B")
- .S FBQUIT=0
- .D CLEAR()
- .S DIR("A")="ENTER FIRST date to include in reports"
- .S DIR(0)="D"
- .D ^DIR
- .I $D(DUOUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS ONE UP ARROW
- .I $D(DIRUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
- .I $D(DTOUT) S FBQUIT1=1 ;DEFINED IF USER TIMES OUT
- .W:'FBQUIT1 " "_Y(0)
- .I 'FBQUIT1 D
- ..S FBFROM=+Y
- ..S DIR("A")="ENTER LAST date to include in reports"
- ..S DIR(0)="D"
- ..D ^DIR
- ..I $D(DUOUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS ONE UP ARROW
- ..I $D(DIRUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
- ..I $D(DTOUT) S FBQUIT1=1 ;DEFINED IF USER TIMES OUT
- ..W:'FBQUIT1 " "_Y(0)
- .I 'FBQUIT1 D
- ..S FBTO=+Y
- ..S X1=FBFROM
- ..S X2=-1
- ..D C^%DTC ;SUBTRACT ONE DAY FROM THE 'START' DATE FOR $O
- ..S FBDATE=X
- ..;FIRST GATHER THE SORTED DATA TO BE REPORTED IN A TMP ARRAY
- ..F S FBDATE=$O(^FB(161.9,"AC",FBDATE)) Q:(FBDATE>FBTO)!(FBDATE="") D
- ...S FBIEN=0
- ...F S FBIEN=$O(^FB(161.9,"AC",FBDATE,FBIEN)) Q:FBIEN="" D
- ....S FBNODE=^FB(161.9,FBIEN,0)
- ....S FBPROG=$P(FBNODE,U,2)
- ....S FBNPI=$P(FBNODE,U,8)
- ....S:FBNPI'="" ^TMP($J,"FBPAID3B",FBDATE,FBPROG,FBNPI,FBIEN)=FBNODE ;only include processed records
- ..I '$D(^TMP($J,"FBPAID3B")) W !,"No Processed Entries in Date Range" Q
- ..;NOW SET UP FILTERING IN A LOOP so more than one report can be generated from it
- ..F Q:FBQUIT D
- ...D CLEAR()
- ...S DIR("A")="SELECT PROGRAM TYPE to include"
- ...S DIR(0)="S^3:OUTPATIENT;9:CIVIL HOSPITAL;0:BOTH"
- ...D ^DIR
- ...I $D(DUOUT) S FBQUIT=1 ;DEFINED IF USER ENTERS ONE UP ARROW
- ...I $D(DIRUT) S FBQUIT=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
- ...I $D(DTOUT) S FBQUIT=1 ;DEFINED IF USER TIMES OUT
- ...Q:FBQUIT
- ...S FBPROG=+Y
- ...S DIR("A")="SELECT NPI STATUS to include"
- ...S DIR(0)="S^0:FOR NO NPI UPDATES ATTEMPTED;1:NPI DATA INVALID;2:NPI MATCHED ACTIVE, NO UPDATES;"
- ...S DIR(0)=DIR(0)_"3:NPI MATCHED INACTIVE, NO UPDATES;4:NPI MATCHED ACTIVE, IB UPDATED;5:NPI NEW, IB RECORD CREATED;"
- ...S DIR(0)=DIR(0)_"99:ALL"
- ...D ^DIR
- ...I $D(DUOUT) S FBQUIT=1 ;DEFINED IF USER ENTERS ONE UP ARROW
- ...I $D(DIRUT) S FBQUIT=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
- ...I $D(DTOUT) S FBQUIT=1 ;DEFINED IF USER TIMES OUT
- ...Q:FBQUIT
- ...S FBNPISRT=+Y
- ...D DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO)
- K ^TMP($J,"FBPAID3B")
- Q
- DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO) ;DISPLAYS SUBSET OF SORTED INFO IN ^TMP
- ;
- ; INPUT : FBPROG - a number identifying the selected program
- ; FBNPISRT - a number indentifying the selected NPI sort value
- ; FBFROM - the "FROM DATE" selected by user
- ; FBTO - The "TO DATE" selected by user
- ;
- N FBNDATE,FBTYPE1,FBNPI1,FBIEN,FBPATIEN,FBICTRL,FBLINUM,FBPTYPE,FBIBPNTR,FBQUIT,FBERR,FBHDSTG,FBHDSTG1
- N FBICNTRL,FBPAT,FBTXY,FBVNDR,FBINVDT,FBHDSTG2,FBDAT1,FBDAT2,DO,DD,X,%,%H,%I,FBNOW,FBFIRST,%ZIS,FBPINFO
- ;
- D NOW^%DTC
- S Y=%
- D DD^%DT
- S FBNOW=Y
- S FBQUIT=0
- S FBFIRST=1
- S %ZIS("A")="OUTPUT DEVICE: "
- D ^%ZIS
- I POP S FBQUIT=1
- Q:FBQUIT
- S FBNDATE=0
- S Y=FBFROM
- D DD^%DT
- S FBDAT1=Y
- S Y=FBTO
- D DD^%DT
- S FBDAT2=Y
- W !
- W ?10,"**** FEE BASIS PROVIDER TO IB REPORT ****"
- W !,?20,FBNOW
- W !,?8,"PROCESS DATES: "_FBDAT1_" - "_FBDAT2
- W !,?8,"PROGRAM: "_$S(FBPROG=0:"BOTH",FBPROG=3:"OUTPATIENT",FBPROG=9:"CIVIL HOSPITAL",1:"")_" NPI SORT: "_$S(FBNPISRT=99:"ALL",1:$$GTNPIVAL(FBNPISRT))
- W !
- F S FBNDATE=$O(^TMP($J,"FBPAID3B",FBNDATE)) Q:(FBNDATE=""!FBQUIT) D
- .S Y=FBNDATE
- .D DD^%DT
- .S FBHDSTG="PROCESS DATE: "_Y
- .S FBTYPE1=""
- .F S FBTYPE1=$O(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1)) Q:(FBTYPE1=""!FBQUIT) D
- ..I FBPROG'=0&(FBTYPE1'=FBPROG) Q ;NOT A PROGRAM TYPE WE WANT TO REPORT ON
- ..S:FBTYPE1=3 FBHDSTG1="OUTPATIENT"
- ..S:FBTYPE1=9 FBHDSTG1="CIVIL HOSPITAL"
- ..S FBNPI1=""
- ..S FBFIRST=1
- ..F S FBNPI1=$O(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1)) Q:(FBNPI1=""!FBQUIT) D
- ...I (FBNPISRT'=99)&(FBNPISRT'=FBNPI1) Q ;NOT AN NPI UPDATE VALUE WE WANT TO REPORT ON
- ...S FBHDSTG2=$$GTNPIVAL(FBNPI1)
- ...I ((IOT="VTRM")&'FBFIRST) D
- ....S DIR("A")="PRESS ENTER TO CONTINUE"
- ....S DIR(0)="FO"
- ....D ^DIR
- ....I $D(DUOUT) S FBQUIT=1 ;DEFINED IF USER ENTERS ONE UP ARROW
- ....I $D(DTOUT) S FBQUIT=1 ;DEFINED IF USER TIMES OUT
- ...Q:FBQUIT
- ...S FBIEN=0
- ...W !,?3,FBHDSTG_" "_FBHDSTG1_" "_FBHDSTG2,!
- ...F S FBIEN=$O(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN)) Q:FBIEN="" D
- ....S FBPATIEN=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,1)
- ....S FBICNTRL=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,3)
- ....S FBLINUM=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,5)
- ....S FBPTYPE=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,6)
- ....S FBIBPNTR=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,7)
- ....S FBTXY=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,9)
- ....;NOW GET INFO FROM THE FEE BASIS PAYMENT FILE IF THIS IS A TYPE 3
- ....I FBTYPE1=3 S FBPINFO=$$GTPYMNT(FBICNTRL)
- ....W:FBTYPE1=3 !,?5,$P(FBPINFO,U,1)_" => "_$P(FBPINFO,U,2)_" => "
- ....W:FBTYPE1=3 !,?8,$P(FBPINFO,U,3)_" => "_$P(FBPINFO,U,4)
- ....W:FBTYPE1=9 !,?5,"INVOICE: "_FBICNTRL
- ....W !,?5,"IB PROVIDER NAME: "_$$GTIBNAM(FBIBPNTR)
- ....W !,?8,$$GTTXYVAL(FBIEN)
- ....W !,?5,"PROVIDER TYPE: "_$$GTPRVTYP(FBIEN)
- ....W:FBLINUM>0 " "_"(LI) "_FBLINUM
- ....W !
- ....S FBFIRST=0
- Q
- ;
- GTPRVTYP(FBIEN) ;RETURNS EXTERNAL VALUE FOR A CODE IN A SET
- ;
- Q:FBIEN="" ""
- Q $$GET1^DIQ(161.9,FBIEN_",",.06,"","","FBERR")
- ;
- GTIBNAM(FBIBPNTR) ;RETURNS EXTERNAL VALUE FOR NAME OF IB NON/OTHER VA BILLING PROVIDER
- ; INPUT : FBIBPNTR - pointer to the IB NON/OTHER VA BILLING PROVIDER FILE - 355,93
- N FBERR
- Q:FBIBPNTR="" ""
- Q $$GET1^DIQ(355.93,FBIBPNTR_",",.01,"","","FBERR")
- ;
- GTTXYVAL(FBIEN) ;RETURNS EXTERNAL VALUE FOR TAXONOMY UPDATE CODE
- ; INPUT : FBIEN - pointer to the FEE BASIS PAID TO IB file - 161.9
- N FBERR
- Q:FBIEN=""
- Q $$GET1^DIQ(161.9,FBIEN_",",.09,"","","FBERR")
- ;
- GTNPIVAL(FBNPI1) ;RETURNS EXTERNAL VALUE FOR A SET OF SORT CODES
- ; INPUT : FBNPI1 - USER SELECTED value from set of code
- N FBERR
- Q:FBNPI1="" ""
- Q:FBNPI1=0 "NO NPI UPDATES ATTEMPTED"
- Q:FBNPI1=1 "NPI DATA INVALID"
- Q:FBNPI1=2 "NPI MATCHED ACTIVE, NO UPDATES"
- Q:FBNPI1=3 "NPI MATCHED INACTIVE, NO UPDATES"
- Q:FBNPI1=4 "NPI MATCHED ACTIVE, IB UPDATED"
- Q:FBNPI1=5 "NPI NEW, IB RECORD CREATED"
- Q -1
- ;
- GTPYMNT(FBICNTRL) ;Get info from FEE BASIS PAYMENT
- ;INPUT : FBICNTRL - a four piece ';' delimitated string representing a sub record
- N FBIENS,FBPAT,FBVNDR,FBINVDT,FBPROC
- ;
- S FBIENS=$P(FBICNTRL,";",1)_","
- S FBPAT=$$GET1^DIQ(162,FBIENS,.01,"","","FBERR")
- S FBIENS=$P(FBICNTRL,";",2)_","_FBIENS
- S FBVNDR=$$GET1^DIQ(162.01,FBIENS,.01,"","","FBERR")
- S FBIENS=$P(FBICNTRL,";",3)_","_FBIENS
- S FBINVDT=$$GET1^DIQ(162.02,FBIENS,.01,"","","FBERR")
- S FBIENS=$P(FBICNTRL,";",4)_","_FBIENS
- S FBPROC=$$GET1^DIQ(162.03,FBIENS,.01,"","","FBERR")
- Q FBPAT_"^"_FBVNDR_"^"_FBINVDT_"^"_FBPROC
- ;
- CLEAR() ;CLEARS A SPACE ON SCREEN AFTER REPORT
- N FBLINE
- F FBLINE=1:1:10 W !
- Q
-
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBPAID3B 7636 printed Mar 13, 2025@21:04:21 Page 2
- FBPAID3B ;DSS/SCR - Utilities to support FEE BASIS PAID TO IB Process ;3/28/1012
- +1 ;;3.5;FEE BASIS;**135**;JAN 30, 1995;Build 3
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- EPFBPRV() ;EP FROM OPTION [FB PROVIDER TO IB]
- +1 ;
- +2 ;REPORTING OPTION FOR FB PAID TO IB AUTOMATIC INTERFACE TO IB NON/OTHER VA BILLING PROVIDER FILE
- +3 ;
- +4 NEW DUOUT,DIRUT,DTOUT,FBQUIT,DIR,FBFROM,FBTO,FBDATE,FBIEN,FBNODE,FBPROG,FBNPI,FBNPISRT,Y,X1,X2,X,FBQUIT1
- +5 NEW FBTODATE
- +6 ;
- +7 SET FBQUIT1=0
- +8 FOR
- if FBQUIT1
- QUIT
- Begin DoDot:1
- +9 KILL ^TMP($JOB,"FBPAID3B")
- +10 SET FBQUIT=0
- +11 DO CLEAR()
- +12 SET DIR("A")="ENTER FIRST date to include in reports"
- +13 SET DIR(0)="D"
- +14 DO ^DIR
- +15 ;DEFINED IF USER ENTERS ONE UP ARROW
- IF $DATA(DUOUT)
- SET FBQUIT1=1
- +16 ;DEFINED IF USER ENTERS TWO UP ARROWS
- IF $DATA(DIRUT)
- SET FBQUIT1=1
- +17 ;DEFINED IF USER TIMES OUT
- IF $DATA(DTOUT)
- SET FBQUIT1=1
- +18 if 'FBQUIT1
- WRITE " "_Y(0)
- +19 IF 'FBQUIT1
- Begin DoDot:2
- +20 SET FBFROM=+Y
- +21 SET DIR("A")="ENTER LAST date to include in reports"
- +22 SET DIR(0)="D"
- +23 DO ^DIR
- +24 ;DEFINED IF USER ENTERS ONE UP ARROW
- IF $DATA(DUOUT)
- SET FBQUIT1=1
- +25 ;DEFINED IF USER ENTERS TWO UP ARROWS
- IF $DATA(DIRUT)
- SET FBQUIT1=1
- +26 ;DEFINED IF USER TIMES OUT
- IF $DATA(DTOUT)
- SET FBQUIT1=1
- +27 if 'FBQUIT1
- WRITE " "_Y(0)
- End DoDot:2
- +28 IF 'FBQUIT1
- Begin DoDot:2
- +29 SET FBTO=+Y
- +30 SET X1=FBFROM
- +31 SET X2=-1
- +32 ;SUBTRACT ONE DAY FROM THE 'START' DATE FOR $O
- DO C^%DTC
- +33 SET FBDATE=X
- +34 ;FIRST GATHER THE SORTED DATA TO BE REPORTED IN A TMP ARRAY
- +35 FOR
- SET FBDATE=$ORDER(^FB(161.9,"AC",FBDATE))
- if (FBDATE>FBTO)!(FBDATE="")
- QUIT
- Begin DoDot:3
- +36 SET FBIEN=0
- +37 FOR
- SET FBIEN=$ORDER(^FB(161.9,"AC",FBDATE,FBIEN))
- if FBIEN=""
- QUIT
- Begin DoDot:4
- +38 SET FBNODE=^FB(161.9,FBIEN,0)
- +39 SET FBPROG=$PIECE(FBNODE,U,2)
- +40 SET FBNPI=$PIECE(FBNODE,U,8)
- +41 ;only include processed records
- if FBNPI'=""
- SET ^TMP($JOB,"FBPAID3B",FBDATE,FBPROG,FBNPI,FBIEN)=FBNODE
- End DoDot:4
- End DoDot:3
- +42 IF '$DATA(^TMP($JOB,"FBPAID3B"))
- WRITE !,"No Processed Entries in Date Range"
- QUIT
- +43 ;NOW SET UP FILTERING IN A LOOP so more than one report can be generated from it
- +44 FOR
- if FBQUIT
- QUIT
- Begin DoDot:3
- +45 DO CLEAR()
- +46 SET DIR("A")="SELECT PROGRAM TYPE to include"
- +47 SET DIR(0)="S^3:OUTPATIENT;9:CIVIL HOSPITAL;0:BOTH"
- +48 DO ^DIR
- +49 ;DEFINED IF USER ENTERS ONE UP ARROW
- IF $DATA(DUOUT)
- SET FBQUIT=1
- +50 ;DEFINED IF USER ENTERS TWO UP ARROWS
- IF $DATA(DIRUT)
- SET FBQUIT=1
- +51 ;DEFINED IF USER TIMES OUT
- IF $DATA(DTOUT)
- SET FBQUIT=1
- +52 if FBQUIT
- QUIT
- +53 SET FBPROG=+Y
- +54 SET DIR("A")="SELECT NPI STATUS to include"
- +55 SET DIR(0)="S^0:FOR NO NPI UPDATES ATTEMPTED;1:NPI DATA INVALID;2:NPI MATCHED ACTIVE, NO UPDATES;"
- +56 SET DIR(0)=DIR(0)_"3:NPI MATCHED INACTIVE, NO UPDATES;4:NPI MATCHED ACTIVE, IB UPDATED;5:NPI NEW, IB RECORD CREATED;"
- +57 SET DIR(0)=DIR(0)_"99:ALL"
- +58 DO ^DIR
- +59 ;DEFINED IF USER ENTERS ONE UP ARROW
- IF $DATA(DUOUT)
- SET FBQUIT=1
- +60 ;DEFINED IF USER ENTERS TWO UP ARROWS
- IF $DATA(DIRUT)
- SET FBQUIT=1
- +61 ;DEFINED IF USER TIMES OUT
- IF $DATA(DTOUT)
- SET FBQUIT=1
- +62 if FBQUIT
- QUIT
- +63 SET FBNPISRT=+Y
- +64 DO DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +65 KILL ^TMP($JOB,"FBPAID3B")
- +66 QUIT
- DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO) ;DISPLAYS SUBSET OF SORTED INFO IN ^TMP
- +1 ;
- +2 ; INPUT : FBPROG - a number identifying the selected program
- +3 ; FBNPISRT - a number indentifying the selected NPI sort value
- +4 ; FBFROM - the "FROM DATE" selected by user
- +5 ; FBTO - The "TO DATE" selected by user
- +6 ;
- +7 NEW FBNDATE,FBTYPE1,FBNPI1,FBIEN,FBPATIEN,FBICTRL,FBLINUM,FBPTYPE,FBIBPNTR,FBQUIT,FBERR,FBHDSTG,FBHDSTG1
- +8 NEW FBICNTRL,FBPAT,FBTXY,FBVNDR,FBINVDT,FBHDSTG2,FBDAT1,FBDAT2,DO,DD,X,%,%H,%I,FBNOW,FBFIRST,%ZIS,FBPINFO
- +9 ;
- +10 DO NOW^%DTC
- +11 SET Y=%
- +12 DO DD^%DT
- +13 SET FBNOW=Y
- +14 SET FBQUIT=0
- +15 SET FBFIRST=1
- +16 SET %ZIS("A")="OUTPUT DEVICE: "
- +17 DO ^%ZIS
- +18 IF POP
- SET FBQUIT=1
- +19 if FBQUIT
- QUIT
- +20 SET FBNDATE=0
- +21 SET Y=FBFROM
- +22 DO DD^%DT
- +23 SET FBDAT1=Y
- +24 SET Y=FBTO
- +25 DO DD^%DT
- +26 SET FBDAT2=Y
- +27 WRITE !
- +28 WRITE ?10,"**** FEE BASIS PROVIDER TO IB REPORT ****"
- +29 WRITE !,?20,FBNOW
- +30 WRITE !,?8,"PROCESS DATES: "_FBDAT1_" - "_FBDAT2
- +31 WRITE !,?8,"PROGRAM: "_$SELECT(FBPROG=0:"BOTH",FBPROG=3:"OUTPATIENT",FBPROG=9:"CIVIL HOSPITAL",1:"")_" NPI SORT: "_$SELECT(FBNPISRT=99:"ALL",1:$$GTNPIVAL(FBNPISRT))
- +32 WRITE !
- +33 FOR
- SET FBNDATE=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE))
- if (FBNDATE=""!FBQUIT)
- QUIT
- Begin DoDot:1
- +34 SET Y=FBNDATE
- +35 DO DD^%DT
- +36 SET FBHDSTG="PROCESS DATE: "_Y
- +37 SET FBTYPE1=""
- +38 FOR
- SET FBTYPE1=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1))
- if (FBTYPE1=""!FBQUIT)
- QUIT
- Begin DoDot:2
- +39 ;NOT A PROGRAM TYPE WE WANT TO REPORT ON
- IF FBPROG'=0&(FBTYPE1'=FBPROG)
- QUIT
- +40 if FBTYPE1=3
- SET FBHDSTG1="OUTPATIENT"
- +41 if FBTYPE1=9
- SET FBHDSTG1="CIVIL HOSPITAL"
- +42 SET FBNPI1=""
- +43 SET FBFIRST=1
- +44 FOR
- SET FBNPI1=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1))
- if (FBNPI1=""!FBQUIT)
- QUIT
- Begin DoDot:3
- +45 ;NOT AN NPI UPDATE VALUE WE WANT TO REPORT ON
- IF (FBNPISRT'=99)&(FBNPISRT'=FBNPI1)
- QUIT
- +46 SET FBHDSTG2=$$GTNPIVAL(FBNPI1)
- +47 IF ((IOT="VTRM")&'FBFIRST)
- Begin DoDot:4
- +48 SET DIR("A")="PRESS ENTER TO CONTINUE"
- +49 SET DIR(0)="FO"
- +50 DO ^DIR
- +51 ;DEFINED IF USER ENTERS ONE UP ARROW
- IF $DATA(DUOUT)
- SET FBQUIT=1
- +52 ;DEFINED IF USER TIMES OUT
- IF $DATA(DTOUT)
- SET FBQUIT=1
- End DoDot:4
- +53 if FBQUIT
- QUIT
- +54 SET FBIEN=0
- +55 WRITE !,?3,FBHDSTG_" "_FBHDSTG1_" "_FBHDSTG2,!
- +56 FOR
- SET FBIEN=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN))
- if FBIEN=""
- QUIT
- Begin DoDot:4
- +57 SET FBPATIEN=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,1)
- +58 SET FBICNTRL=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,3)
- +59 SET FBLINUM=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,5)
- +60 SET FBPTYPE=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,6)
- +61 SET FBIBPNTR=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,7)
- +62 SET FBTXY=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,9)
- +63 ;NOW GET INFO FROM THE FEE BASIS PAYMENT FILE IF THIS IS A TYPE 3
- +64 IF FBTYPE1=3
- SET FBPINFO=$$GTPYMNT(FBICNTRL)
- +65 if FBTYPE1=3
- WRITE !,?5,$PIECE(FBPINFO,U,1)_" => "_$PIECE(FBPINFO,U,2)_" => "
- +66 if FBTYPE1=3
- WRITE !,?8,$PIECE(FBPINFO,U,3)_" => "_$PIECE(FBPINFO,U,4)
- +67 if FBTYPE1=9
- WRITE !,?5,"INVOICE: "_FBICNTRL
- +68 WRITE !,?5,"IB PROVIDER NAME: "_$$GTIBNAM(FBIBPNTR)
- +69 WRITE !,?8,$$GTTXYVAL(FBIEN)
- +70 WRITE !,?5,"PROVIDER TYPE: "_$$GTPRVTYP(FBIEN)
- +71 if FBLINUM>0
- WRITE " "_"(LI) "_FBLINUM
- +72 WRITE !
- +73 SET FBFIRST=0
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +74 QUIT
- +75 ;
- GTPRVTYP(FBIEN) ;RETURNS EXTERNAL VALUE FOR A CODE IN A SET
- +1 ;
- +2 if FBIEN=""
- QUIT ""
- +3 QUIT $$GET1^DIQ(161.9,FBIEN_",",.06,"","","FBERR")
- +4 ;
- GTIBNAM(FBIBPNTR) ;RETURNS EXTERNAL VALUE FOR NAME OF IB NON/OTHER VA BILLING PROVIDER
- +1 ; INPUT : FBIBPNTR - pointer to the IB NON/OTHER VA BILLING PROVIDER FILE - 355,93
- +2 NEW FBERR
- +3 if FBIBPNTR=""
- QUIT ""
- +4 QUIT $$GET1^DIQ(355.93,FBIBPNTR_",",.01,"","","FBERR")
- +5 ;
- GTTXYVAL(FBIEN) ;RETURNS EXTERNAL VALUE FOR TAXONOMY UPDATE CODE
- +1 ; INPUT : FBIEN - pointer to the FEE BASIS PAID TO IB file - 161.9
- +2 NEW FBERR
- +3 if FBIEN=""
- QUIT
- +4 QUIT $$GET1^DIQ(161.9,FBIEN_",",.09,"","","FBERR")
- +5 ;
- GTNPIVAL(FBNPI1) ;RETURNS EXTERNAL VALUE FOR A SET OF SORT CODES
- +1 ; INPUT : FBNPI1 - USER SELECTED value from set of code
- +2 NEW FBERR
- +3 if FBNPI1=""
- QUIT ""
- +4 if FBNPI1=0
- QUIT "NO NPI UPDATES ATTEMPTED"
- +5 if FBNPI1=1
- QUIT "NPI DATA INVALID"
- +6 if FBNPI1=2
- QUIT "NPI MATCHED ACTIVE, NO UPDATES"
- +7 if FBNPI1=3
- QUIT "NPI MATCHED INACTIVE, NO UPDATES"
- +8 if FBNPI1=4
- QUIT "NPI MATCHED ACTIVE, IB UPDATED"
- +9 if FBNPI1=5
- QUIT "NPI NEW, IB RECORD CREATED"
- +10 QUIT -1
- +11 ;
- GTPYMNT(FBICNTRL) ;Get info from FEE BASIS PAYMENT
- +1 ;INPUT : FBICNTRL - a four piece ';' delimitated string representing a sub record
- +2 NEW FBIENS,FBPAT,FBVNDR,FBINVDT,FBPROC
- +3 ;
- +4 SET FBIENS=$PIECE(FBICNTRL,";",1)_","
- +5 SET FBPAT=$$GET1^DIQ(162,FBIENS,.01,"","","FBERR")
- +6 SET FBIENS=$PIECE(FBICNTRL,";",2)_","_FBIENS
- +7 SET FBVNDR=$$GET1^DIQ(162.01,FBIENS,.01,"","","FBERR")
- +8 SET FBIENS=$PIECE(FBICNTRL,";",3)_","_FBIENS
- +9 SET FBINVDT=$$GET1^DIQ(162.02,FBIENS,.01,"","","FBERR")
- +10 SET FBIENS=$PIECE(FBICNTRL,";",4)_","_FBIENS
- +11 SET FBPROC=$$GET1^DIQ(162.03,FBIENS,.01,"","","FBERR")
- +12 QUIT FBPAT_"^"_FBVNDR_"^"_FBINVDT_"^"_FBPROC
- +13 ;
- CLEAR() ;CLEARS A SPACE ON SCREEN AFTER REPORT
- +1 NEW FBLINE
- +2 FOR FBLINE=1:1:10
- WRITE !
- +3 QUIT
- +4
