source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBRXFED.m@ 1801

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1FBRXFED ;WOIFO/SAB-FPPS DATA EDIT PHARMACY INVOICE ;8/12/2003
2 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 I '$D(^XUSEC("FBAASUPERVISOR",DUZ)) D Q
6 . W $C(7),!,"You must hold the FBAASUPERVISOR security key to use this option!"
7 ;
8 S FBAAOUT=0
9 F D INVED Q:FBAAOUT
10 D CLEAN
11 Q
12 ;
13INVED ; Invoice Edit
14 ;
15ASKINV ; Select Invoice to Edit
16 W ! S DIC="^FBAA(162.1,",DIC(0)="AEQM",DIC("A")="Select Invoice #: "
17 ; screen on invoices with completed status and EDI
18 S DIC("S")="I $P(^(0),U,5)=4&($P(^(0),U,13)]"""")"
19 D ^DIC K DIC I Y'>0 S FBAAOUT=1 Q
20 S FBDA=+Y
21 ;
22 I $$CKFPPS^FBFHLL(FBDA)'=1 D G ASKINV
23 . W !?5,"Invoice ",FBDA," has not been transmitted to FPPS."
24 ;
25 ; save FPPS Claim ID data prior to edit session
26 S (FBFPPSC,FBFPPSC(0))=$P($G(^FBAA(162.1,FBDA,0)),U,13)
27 S FBINVCHG=0 ; initialize invoice changed flag
28 ;
29EDITFC ; edit FPPS CLAIM ID
30 S FBX=$$FPPSC^FBUTL5(1,FBFPPSC)
31 I FBX=-1 S FBAAOUT=1 G INVEDX
32 ; need to verify if following restriction is appropriate
33 I FBX="" D G EDITFC
34 . W !,$C(7),"Can not change EDI from YES to NO on invoice that has been sent to FPPS!"
35 S FBFPPSC=FBX
36 ;
37 ; if FPPS CLAIM ID changed, then update file, audit log, and Rx's
38 I FBFPPSC'=FBFPPSC(0) D
39 . ; set invoice changed flag
40 . S FBINVCHG=1
41 . ;
42 . ; file data in 162.1
43 . K FBFDA
44 . S FBFDA(162.1,FBDA_",",13)=$S(FBFPPSC="":"@",1:FBFPPSC)
45 . I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG()
46 . ;
47 . ; add record to audit log
48 . K FBFDA
49 . S FBFDA(163.7,"+1,",.01)=FBDA ; invoice number
50 . S FBFDA(163.7,"+1,",1)=$$NOW^XLFDT() ; date/time changed
51 . S FBFDA(163.7,"+1,",2)=162.1 ; file #
52 . S FBFDA(163.7,"+1,",3)=FBDA_"," ; iens
53 . S FBFDA(163.7,"+1,",4)=13 ; field #
54 . S FBFDA(163.7,"+1,",5)=FBFPPSC(0) ; old value
55 . S FBFDA(163.7,"+1,",6)=FBFPPSC ; new value
56 . S FBFDA(163.7,"+1,",7)=DUZ ; user
57 . I $D(FBFDA) D UPDATE^DIE("","FBFDA") D MSG^DIALOG()
58 . ;
59 . ; update Rx's (would only apply if EDI status can change)
60 . D CKINVEDI^FBAAEPI1(FBFPPSC(0),FBFPPSC,FBDA)
61 ;
62ASKRX ; Select Prescription to Edit
63 W !
64 S DIC="^FBAA(162.1,"_FBDA_",""RX"",",DIC(0)="AEQM"
65 S DIC("W")="W ?30,""DATE RX FILLED: "",$E($P(^(0),U,3),4,5)_""/""_$E($P(^(0),U,3),6,7)_""/""_$E($P(^(0),U,3),2,3)"
66 D ^DIC I $D(DUOUT) S FBAAOUT=1 G INVEDX
67 I Y'>0 D G:$D(DIRUT)!(Y=1) INVEDX G ASKRX
68 . S DIR(0)="Y"
69 . S DIR("A")="Are you finished editing prescriptions on invoice "_FBDA
70 . D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1
71 S FBRXDA=+Y
72 ;
73 ; get current value of FPPS LINE ITEM to use as default
74 S (FBFPPSL(0),FBFPPSL)=$P($G(^FBAA(162.1,FBDA,"RX",FBRXDA,3)),U)
75 ;
76EDITFL ; edit FPPS Line Item
77 S FBX=$$FPPSL^FBUTL5(FBFPPSL)
78 I FBX=-1 S FBAAOUT=1 G INVEDX
79 ; need to verify if following restriction is appropriate
80 S FBFPPSL=FBX
81 ;
82 ; if FPPS LINE ITEM changed, then update file and audit log
83 I FBFPPSL'=FBFPPSL(0) D
84 . ; set invoice changed flag
85 . S FBINVCHG=1
86 . ;
87 . ; file data in 162.11
88 . K FBFDA
89 . S FBFDA(162.11,FBRXDA_","_FBDA_",",36)=FBFPPSL
90 . I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG()
91 . ;
92 . ; add record to audit log
93 . K FBFDA
94 . S FBFDA(163.7,"+1,",.01)=FBDA ; invoice number
95 . S FBFDA(163.7,"+1,",1)=$$NOW^XLFDT() ; date/time changed
96 . S FBFDA(163.7,"+1,",2)=162.11 ; file #
97 . S FBFDA(163.7,"+1,",3)=FBRXDA_","_FBDA_"," ; iens
98 . S FBFDA(163.7,"+1,",4)=36 ; field #
99 . S FBFDA(163.7,"+1,",5)=FBFPPSL(0) ; old value
100 . S FBFDA(163.7,"+1,",6)=FBFPPSL ; new value
101 . S FBFDA(163.7,"+1,",7)=DUZ ; user
102 . I $D(FBFDA) D UPDATE^DIE("","FBFDA") D MSG^DIALOG()
103 ;
104 G ASKRX
105 ;
106INVEDX ; Invoice Edit Exit
107 ; if invoice changed then queue for retransmit to FPPS
108 I FBINVCHG D FILEQUE^FBFHLL(FBDA,5)
109 Q
110 ;
111CLEAN K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
112 K FBAAOUT,FBDA,FBFDA,FBFPPSC,FBFPPSL,FBINVCHG,FBRXDA,FBX
113 Q
114 ;FBRXFED
Note: See TracBrowser for help on using the repository browser.