source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAPET1.m@ 1000

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1FBAAPET1 ;WOIFO/SAB-EDIT PAYMENT ;7/10/2003
2 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4CKINVEDI(FBFPPSC0,FBFPPSC1,FBAAIN,FBIENSE) ; Check Invoice for EDI
5 ; Input
6 ; FBFPPSC0 - old FPPS CLAIM ID
7 ; FBFPPSC1 - new FPPS CLAIM ID
8 ; FBAAIN - invoice number
9 ; FBIENSE - optional, iens of line on invoice that was already edited
10 ; Result
11 ; Lines on invoice may be updated (FPPS CLAIM ID, FPPS LINE ITEM)
12 ;
13 ; If FBFPPSC0]"",FBFPPSC1="" then EDI changed from YES to NO
14 ; need to delete FPPS CLAIM ID and FPPS LINE ITEM
15 ; If FBFPPSC0="",FBFPPSC1]"" then EDI changed from NO to YES
16 ; need to update FPPS CLAIM ID and prompt FPPS LINE ITEM
17 ; If FBFPPSC0]"",FBFPPSC1]"",FBFPPSC0'=FBFPPSC1 then
18 ; EDI stayed YES, but FPPS CLAIM ID was changed
19 ; need to update FPPS CLAIM ID
20 ;
21 N FBASKLN,FBFDA,FBFPPSC,FBFPPSL,FBI,FBIENS,FBMILL,FBUPDLN
22 ;
23 S FBIENSE=$G(FBIENSE)
24 ;
25 I FBFPPSC0=FBFPPSC1 Q ; FPPS CLAIM ID was not changed
26 ;
27 ; Get Lines on Invoice
28 D MILL(FBAAIN,.FBMILL)
29 ;
30 I FBIENSE]"",FBMILL(0)=1 Q ; only 1 line and it has been updated
31 ;
32 S (FBASKLN,FBUPDLN)=0
33 I FBFPPSC0]"",FBFPPSC1="" S (FBFPPSC,FBFPPSL)="@",FBUPDLN=1
34 I FBFPPSC0="",FBFPPSC1]"" S FBFPPSC=FBFPPSC1,(FBASKLN,FBUPDLN)=1
35 I FBFPPSC0]"",FBFPPSC1]"" S FBFPPSC=FBFPPSC1
36 ;
37 W !,"FPPS CLAIM ID was changed. Updating lines on invoice..."
38 I FBASKLN D
39 . W !,"Since EDI Claim from FPPS was changed from NO to YES, the"
40 . W !,"FPPS LINE ITEM must be entered for each line on the invoice."
41 ;
42 ; loop thru lines
43 S FBI=0 F S FBI=$O(FBMILL(FBI)) Q:'FBI D
44 . S FBIENS=FBMILL(FBI)
45 . I FBIENS=FBIENSE Q ; already updated
46 . S FBFDA(162.03,FBIENS,50)=FBFPPSC
47 . I FBASKLN D DSPLIL S FBFPPSL=$$FPPSL^FBUTL5(,,1)
48 . I FBUPDLN,$G(FBFPPSL)]"" S FBFDA(162.03,FBIENS,51)=FBFPPSL
49 I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG()
50 ;
51 Q
52 ;
53MILL(FBAAIN,FBMILL) ; Medical Invoice Line List
54 ; Input
55 ; FBAAIN - invoice #
56 ; FBMILL - array, passed by reference
57 ; Result
58 ;
59 ; Output
60 ; FBMILL - input array will be updated to contain
61 ; FBMILL(0)=FBC
62 ; FBMILL(FBI)=FBIENS
63 ; Where
64 ; FBC = number of lines on invoice
65 ; FBI = integer number
66 ; FBIENS = internal entry number of line item (subfile 162.03),
67 ; fileman DBS format
68 ;
69 N DA,FBC
70 ; initialize
71 K FBMILL
72 S FBC=0 ; count
73 ; loop thru x-ref
74 S DA(3)=0
75 F S DA(3)=$O(^FBAAC("C",FBAAIN,DA(3))) Q:'DA(3) D
76 .S DA(2)=0
77 .F S DA(2)=$O(^FBAAC("C",FBAAIN,DA(3),DA(2))) Q:'DA(2) D
78 ..S DA(1)=0
79 ..F S DA(1)=$O(^FBAAC("C",FBAAIN,DA(3),DA(2),DA(1))) Q:'DA(1) D
80 ...S DA=0
81 ...F S DA=$O(^FBAAC("C",FBAAIN,DA(3),DA(2),DA(1),DA)) Q:'DA D
82 ....S FBC=FBC+1
83 ....S FBMILL(FBC)=DA_","_DA(1)_","_DA(2)_","_DA(3)_","
84 ; save count of lines
85 S FBMILL(0)=FBC
86 Q
87 ;
88DSPLIL ; Display Invoice Line
89 ; Input
90 ; FBIENS - iens of line to display
91 N DA,FBMODA,FBMODL
92 D DA^DILF(FBIENS,.DA)
93 D MODDATA^FBAAUTL4(DA(3),DA(2),DA(1),DA)
94 S FBMODL=$$MODL^FBAAUTL4("FBMODA","E")
95 W !!
96 W "SVC DATE: ",$$GET1^DIQ(162.02,DA(1)_","_DA(2)_","_DA(3)_",",.01)
97 W ?23,"CPT-MOD: ",$$GET1^DIQ(162.03,FBIENS,.01)
98 I FBMODL]"" W "-",FBMODL
99 W ?43,"REV. CODE: ",$$GET1^DIQ(162.03,FBIENS,48)
100 W ?63,"AMT CLAIMED: ",$$GET1^DIQ(162.03,FBIENS,1)
101 Q
102 ;
103 ;FBAAPET1
Note: See TracBrowser for help on using the repository browser.