Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBPAID3B

FBPAID3B.m

Go to the documentation of this file.
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