source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBFPDS.m@ 952

Last change on this file since 952 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1FBFPDS ;WCIOFO/SAB-REPORT OF VENDORS WITHOUT FPDS DATA ;9/15/97
2 ;;3.5;FEE BASIS;**9**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ; entry point
5 ;
6 S DIR(0)="Y",DIR("A")="Only check FPDS data for active vendors"
7 S DIR("B")="YES"
8 S DIR("?",1)="Enter YES if only active vendors should be checked for"
9 S DIR("?",2)="missing FPDS data. A vendor is considered active if there"
10 S DIR("?",3)="has been a treatment/invoice after a user-specified date."
11 S DIR("?",4)=" "
12 S DIR("?")="Enter either 'Y' or 'N'."
13 D ^DIR K DIR G:$D(DIRUT) EXIT S FBACT=Y
14 I FBACT D G:$D(DIRUT) EXIT
15 . S DIR(0)="D",DIR("A")="Consider vendor active when activity since"
16 . S DIR("B")=$$FMTE^XLFDT($E($$FMADD^XLFDT(DT,-540),1,5)_"01")
17 . D ^DIR K DIR Q:$D(DIRUT) S FBACT("D")=Y
18 ;
19 S DIR(0)="Y",DIR("A")="Print detailed vendor demographic data"
20 S DIR("B")="NO"
21 D ^DIR K DIR G:$D(DIRUT) EXIT S FBVD=Y
22 ;
23 S VAR="FBACT^FBACT(^FBVD",PGM="QEN^FBFPDS" D ZIS^FBAAUTL G:FBPOP EXIT
24 ;
25QEN ; queued entry point
26 U IO
27 S FBOUT=0
28 ; gather/sort data
29 K ^TMP($J)
30 S (FBIEN,FBT)=0 F S FBIEN=$O(^FBAAV(FBIEN)) Q:'FBIEN D Q:FBOUT
31 . S FBT=FBT+1
32 . I '(FBT#100) W:$E(IOST,1,2)="C-" "." I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBOUT=1 Q
33 . S FBBT=$P($G(^FBAAV(FBIEN,1)),U,10)
34 . I FBBT]"" Q ; FPDS Data exists *** groups? $O(^FBAAV(FBIEN,2,0))
35 . ; processing vendors with blank FPDS data
36 . Q:$P($G(^FBAAV(FBIEN,"ADEL")),U)="Y" ; Austin Deleted: Don't report.
37 . I FBACT D Q:'FBVENACT ; if user just asked for active vendors
38 . . S FBVENACT=0 ; init vendor active flag
39 . . ; is vendor active in Outpatient Medical
40 . . S FBX=$O(^FBAAC("AX",FBIEN,0))
41 . . S FBX("D")=$S(FBX:9999999.9999-FBX,1:"") ; treatment date
42 . . I FBX("D")'<FBACT("D") S FBVENACT=1 Q ; active medical vendor
43 . . ; or is vendor active in Pharmacy
44 . . S FBI=$O(^FBAA(162.1,"AN",FBIEN," "),-1) ; highest ien for vendor
45 . . S FBX("D")=$S(FBI:$P($G(^FBAA(162.1,FBI,0)),U,2),1:"") ;invoice date
46 . . I FBX("D")'<FBACT("D") S FBVENACT=1 Q ; active pharmacy vendor
47 . . ; or is vendor active in Inpatient
48 . . S FBX=$O(^FBAAI("AF",FBIEN,0))
49 . . S FBX("D")=$S(FBX:9999999.9999-FBX,1:"") ; invoice date
50 . . I FBX("D")'<FBACT("D") S FBVENACT=1 Q ; active inpatient vendor
51 . ; save vendor in list
52 . S FBNAME=$P($G(^FBAAV(FBIEN,0)),U) S:FBNAME="" FBNAME="UNKNOWN"
53 . S ^TMP($J,FBNAME,FBIEN)=""
54 ;
55 ; print data
56 S $P(FBDASH,"=",80)="",$P(FBDASH1,"-",80)="",FBPG=0
57 S FBDTR=$$FMTE^XLFDT($$NOW^XLFDT())
58 D HD
59 S FBT=0
60 S FBNAME="" F S FBNAME=$O(^TMP($J,FBNAME)) Q:FBNAME="" D Q:FBOUT
61 . S FBIEN=0 F S FBIEN=$O(^TMP($J,FBNAME,FBIEN)) Q:'FBIEN D Q:FBOUT
62 . . S FBT=FBT+1
63 . . S FBY(0)=$G(^FBAAV(FBIEN,0))
64 . . S FBNAME=$S($P(FBY(0),U)]"":$P(FBY(0),U),1:"UNKNOWN")
65 . . S FBID=$S($P(FBY(0),U,2)]"":$P(FBY(0),U,2),1:"UNKNOWN")
66 . . I 'FBVD D:$Y+6>IOSL HD Q:FBOUT W !,FBNAME,?50,"ID: ",FBID Q
67 . . ;
68 . . I $Y+17>IOSL D HD Q:FBOUT
69 . . F FBX=1,"ADEL","AMS" S FBY(FBX)=$G(^FBAAV(FBIEN,FBX))
70 . . W !!,$J("Name:",13),?15,$E(FBNAME,1,30),?48,"ID Number: ",FBID
71 . . I $P(FBY("ADEL"),U)="Y" W !?19,"==> FLAGGED FOR DELETION <=="
72 . . E I $$CKVEN^FBAADV(FBIEN) W !?20,"==> AWAITING AUSTIN APPROVAL <=="
73 . . W !,$J("Address:",13),?15,$P(FBY(0),U,3)
74 . . W ?48,"Specialty: ",$E($$GET1^DIQ(161.2,FBIEN,.05),1,20)
75 . . I $P(FBY(0),U,14)]"" W !,$J("Address [2]:",13),?15,$P(FBY(0),U,14)
76 . . W !,$J("City:",13),?15,$P(FBY(0),U,4)
77 . . W ?53,"Type:",?59,$$EXTERNAL^DILFD(161.2,6,"",$P(FBY(0),U,7))
78 . . W !,$J("State:",13),?15,$$GET1^DIQ(161.2,FBIEN,4)
79 . . S FBX=$$GET1^DIQ(161.2,FBIEN,7)
80 . . W ?39,"Participation Code:",?59,$S(FBX]"":$E(FBX,1,21),1:"UNKNOWN")
81 . . W !,$J("ZIP:",13),?15,$P(FBY(0),U,6)
82 . . W ?39,"Medicare ID Number:",?59,$P(FBY(0),U,17)
83 . . W !,$J("County:",13),?15,$$GET1^DIQ(161.2,FBIEN,5.5)
84 . . W ?52,"Chain: ",$P(FBY(0),U,10)
85 . . W !,$J("Phone:",13),?15,$P(FBY(1),U)
86 . . W !,$J("Fax:",13),?15,$P(FBY(1),U,9)
87 . . W:$P(FBY("AMS"),U,2)="Y" ?44,"Pricer Exempt: Yes"
88 . . W !,$J("Type (FPDS):",13)
89 . . W ?15,$$EXTERNAL^DILFD(161.2,24,"",$P(FBY(1),U,10))
90 . . S (FBC,FBI)=0 F S FBI=$O(^FBAAV(FBIEN,2,FBI)) Q:'FBI D
91 . . . S FBX=$P($G(^FBAAV(FBIEN,2,FBI,0)),U) Q:'FBX
92 . . . S FBX=$$GET1^DIQ(420.6,FBX,1) Q:FBX=""
93 . . . S FBC=FBC+1
94 . . . I '(FBC#2) W !,$J("Group (FPDS):",13),?15,$E(FBX,1,21)
95 . . . I (FBC#2) W ?45,"Group (FPDS):",?59,$E(FBX,1,21)
96 . . W !,$J("Austin Name:",13),?15,$P(FBY("AMS"),U)
97 . . W !,$J("Last Change ",13),?44,"Last Change"
98 . . I $P(FBY("ADEL"),U,5)]"" W " by ",$S($P(FBY("ADEL"),U,5)="000":"Non-Fee User",1:"Station "_$P(FBY("ADEL"),U,5))
99 . . W !,$J("TO Austin:",13),?15,$$DATX^FBAAUTL($P(FBY("ADEL"),U,2))
100 . . W ?46,"FROM Austin: ",$$DATX^FBAAUTL($P(FBY("ADEL"),U,4))
101 ;
102 I FBOUT W !!,"JOB STOPPED AT USER REQUEST"
103 I 'FBOUT W !!,"TOTAL number of vendors missing FPDS data: ",FBT
104 I 'FBOUT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
105 D ^%ZISC
106 ;
107EXIT ;
108 I $D(ZTQUEUED) S ZTREQ="@"
109 K ^TMP($J),DIROUT,DIRUT,DTOUT,DUOUT,X,Y
110 K FBDASH,FBDASH1,FBDTR,FBPG,FBOUT,FBPOP
111 K FBACT,FBBT,FBC,FBI,FBID,FBIEN,FBNAME,FBT,FBVD,FBVENACT,FBX,FBY
112 Q
113 ;
114HD ; header
115 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBOUT=1 Q
116 I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBOUT=1 Q
117 I $E(IOST,1,2)="C-"!FBPG W @IOF
118 S FBPG=FBPG+1
119 W !,"FEE BASIS VENDOR'S WITH BLANK FPDS DATA",?49,FBDTR,?72,"page ",FBPG
120 I $G(FBACT) W !,"of those with activity since ",$$FMTE^XLFDT(FBACT("D"))
121 W !,FBDASH
122 Q
Note: See TracBrowser for help on using the repository browser.