source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOBIL2.m@ 1005

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

initial load of WorldVistAEHR
File size: 7.9 KB
Line 
1RMPOBIL2 ;EDS/MDB - HOME OXYGEN BILLING TRANSACTIONS ;7/28/98
2 ;;3.0;PROSTHETICS;**29,44,46,50,110**;Feb 09, 1996;Build 10
3 ; ODJ patch 50 - Fix crashes reported in NOIS LIT-0600-70930
4 Q
52319 ; SHOW PAGE 8 OF 2319
6 ;S:$D(RMPRDFN)&('$D(RMPODFN)) RMPODFN=RMPRDFN
7 S RMPODFN=RMPRDFN
8 D BPI,DPI
9 K DIR S DIR(0)="E" D ^DIR I $$QUIT G ASK1^RMPRPAT
10 D ^RMPOBIL5
11 K PTI,I,RX,Y,DT1,DT2,TRX,IENS,DFN
12 Q
13QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
14EQUIT() S QUIT=$D(DTOUT)!$D(Y) Q QUIT
15LJ(S,W,C) ; Left justify S in a field W wide padding with char C
16 ;
17 S C=$G(C," ") ; Default pad char is space
18 I $L(S)'=W S $P(S,C,W-$L(S)+$L(S,C))=""
19 Q $E(S,1,W)
20EDIT ;NEW billing transaction edit module
21 ;This module edits a single billing transaction (trx)
22 ;a single trx is identified by 4 values
23 ; site, billing month, vendor, and patient
24 ; these four values represent an entry in file 665.72
25 ;
26 Q:'($D(RMPOXITE)&$D(RMPORVDT)&$D(RMPOVDR)&$D(RMPODFN))
27 Q:'$D(^RMPO(665.72,+RMPOXITE,1,+RMPORVDT,1,+RMPOVDR,"V",+RMPODFN))
28 ; previous two lines for development only - shouldn't be needed
29 ;
30 D ITEM
31EXIT L -^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0)
32 K ITM,IEN,IENS,ITMACT,PTI,TMP,ZX1,TOT,T910,OTH,A,RX,TRX,DT1,DT2
33 K DIC,DIE,DA,DR,DO,DD,DIR,DIK,DIROUT,DUOUT
34 K TIEN,FCP,DFN,I,ITEM,NEW,QUIT,TOTAL,VADM,X,Y,Z,Z1,Z2,ZV,Z3
35 K PSTFLG,PITM,BACKPTR,POSTED,SUSP,DFCP,C,W,S,CIEN,RMIT,RMDIC
36 Q
37QUIK ; QUICK ITEM EDIT
38 ;
39 I '$$OK2EDIT D Q
40 . W !,$C(7)_"Cannot edit Accepted Transactions. "
41 . W "Please 'Unaccept' first." K DIR S DIR(0)="E" D ^DIR
42 I $$LOCKED D Q
43 . W !,$C(7)_"Record is locked. " K DIR S DIR(0)="E" D ^DIR
44 D ITEMD
45 F I=1:1:IEN D Q:QUIT
46 . W !,ITM(I)
47 .K DR D SDICE
48 .S DA=IEN(I),DR="7" D ^DIE Q:$$EQUIT
49 .S Z=^RMPO(665.72,DA(4),1,DA(3),1,DA(2),"V",DA(1),1,DA,0)
50 .S Z1=$P(Z,U,7),Z2=$P(Z,U,5),Z3=$P(Z,U,11)
51 .S DR="6///"_((Z1*Z2)-Z3) D ^DIE Q:$$EQUIT
52 D BII,DII
53 K DIR S DIR(0)="E" D ^DIR Q:$$QUIT
54 G EXIT
55 Q
56ITEM ; Main edit loop
57 ;
58 I '$$OK2EDIT D Q
59 . W !,$C(7)_"Cannot edit Accepted Transactions. "
60 . W "Please 'Unaccept' first." K DIR S DIR(0)="E" D ^DIR
61 I $$LOCKED D Q
62 . W !,$C(7)_"Record is locked. " K DIR S DIR(0)="E" D ^DIR
63 ;
64ITEMLOOP ;
65 ;
66 S QUIT=0
67 D ITEMD
68 ; ask for ACTION, quit if <return>, timeout, etc
69 S ITMACT=$$ITEMO Q:$$QUIT!(ITMACT="")
70 ; if they entered 'A', do ADD ITEM, then edit it
71 I ITMACT="A" D ITEMA Q:QUIT!(ITEM="") D ITEME Q:QUIT G ITEMLOOP
72 ; if they entered 'D', select an item, then delete it
73 I ITMACT="D" D ITEMS Q:QUIT!(ITEM="") D ITEMK G ITEMLOOP
74 ; if they entered 'E', select an item, then edit it
75 I ITMACT="E" D ITEMS Q:QUIT!(ITEM="") D ITEME Q:QUIT G ITEMLOOP
76 ; if they entered 'Z', select an item, then zero it
77 I ITMACT="Z" D ITEMS Q:QUIT!(ITEM="") D ITEMZ Q:QUIT G ITEMLOOP
78 G ITEMLOOP
79 Q
80OK2EDIT() ;
81 ;
82 Q $P(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0),U,2)'="Y"
83 Q
84LOCKED() ;
85 ;
86 L +^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,0):2
87 Q '$T
88 Q
89ITEMD ; Display items
90 ;
91 D BPI,DPI,BII,DII
92 Q
93BPI ; Build pt info hdr
94 K PTI
95 ; Name,SSN
96 S DFN=RMPODFN D DEM^VADPT
97 S PTI(1)=VADM(1)_" "_$P(VADM(2),U,2)
98 ; Current Rx (IEN on ACT DATE)
99 S RX=$O(^RMPR(665,RMPODFN,"RMPOB"," "),-1)
100 Q:'RX
101 S Y=$P(^RMPR(665,RMPODFN,"RMPOB",RX,0),U) X ^DD("DD") S DT1=Y
102 S Y=$P(^RMPR(665,RMPODFN,"RMPOB",RX,0),U,3) X ^DD("DD") S DT2=Y
103 S PTI(2)="Current Prescription (#"_RX_")"
104 S PTI(3)=" Active Date: "_DT1_" Expiration Date: "_DT2
105 ; Rx Remarks
106 K TRX
107 S IENS=RX_","_RMPODFN_","
108 D GETS^DIQ(665.193,IENS,3,,"TRX")
109 S I=0 F S I=$O(TRX(665.193,IENS,3,I)) Q:I="" D
110 . S PTI(3+I)=" "_TRX(665.193,IENS,3,I)
111 Q
112DPI ; Display pt info hdr
113 S I=0 F S I=$O(PTI(I)) Q:I="" W !,PTI(I)
114 Q
115BII ; Build item info array
116 K TRX,ITM,TOT,SUSP,POSTED,PITM,IEN,CIEN
117 S SUSP=0,CIEN=1
118 S IENS=RMPODFN_","_RMPOVDR_","_RMPORVDT_","_RMPOXITE
119 D GETS^DIQ(665.72319,IENS,"**","IE","TRX")
120 S ZX1=""
121 F IEN=0:1 S ZX1=$O(TRX(665.723191,ZX1)) Q:ZX1="" D
122 . K TMP M TMP=TRX(665.723191,ZX1)
123 . F Z=5,6,10 S TMP(Z,"E")=$J($G(TMP(Z,"E")),0,2)
124 . S TIEN=+ZX1 D BIIL
125 K TMP
126 S TMP(2,"E")="HCPCS"
127 S TMP(.01,"E")="Description"
128 S TMP(3,"E")="FCP"
129 S TMP(7,"E")="Qty"
130 S TMP(5,"E")="Cost"
131 S TMP(6,"E")="Total"
132 S TMP(8,"I")=" "
133 S TMP(10,"E")="Susp."
134 S (CIEN,TIEN)=0 D BIIL
135 Q
136BIIL ;Build detail line
137 ;
138 S:TIEN IEN(CIEN)=TIEN ;S:TIEN IEN(TIEN)=TIEN
139 S ITM(CIEN)=" "
140 ;S:TIEN ITM(TIEN)=$J(TIEN,2)_"." ; ITEM #
141 S:TIEN ITM(CIEN)=$J(CIEN,2)_"." ; ITEM #
142 S PSTFLG=$S($G(TMP(8,"I"))="Y":"p",1:" ")
143 S BACKPTR=$G(TMP(12,"I"))
144 S TMP(.01,"E")=$G(TMP(.01,"E"))_" "
145 S ITM(CIEN)=ITM(CIEN)_$$LJ(PSTFLG,2) ; POSTED
146 S ITM(CIEN)=ITM(CIEN)_$$LJ($G(TMP(2,"E")),7) ; HCPCS
147 S ITM(CIEN)=ITM(CIEN)_$$LJ($G(TMP(.01,"E")),30) ; ITEM DESCR
148 S ITM(CIEN)=ITM(CIEN)_" "_$$LJ($P($G(TMP(3,"E"))," "),5) ; FCP
149 S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(7,"E")),5) ; QTY
150 S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(5,"E")),8) ; UNIT COST
151 S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(10,"E")),8) ; SUSP
152 S ITM(CIEN)=ITM(CIEN)_$J($G(TMP(6,"E")),8) ; QTY * CST
153 ; Quit if we're doing the header
154 Q:TIEN=0
155 I $G(TMP(8,"I"))="Y" S POSTED(TIEN)=""
156 ; Do totals while we're here
157 S FCP=+TMP(3,"E"),TOTAL=TMP(6,"E")
158 S TOT(FCP)=$G(TOT(FCP))+TOTAL
159 S TOT=$G(TOT)+TOTAL
160 S SUSP=SUSP+$G(TMP(10,"E")),CIEN=CIEN+1
161 Q
162DII ; Display item info array
163 Q:'$G(IEN)
164 W ! F I=0:1:IEN W !,ITM(I)
165 W !!,"TOTAL COST",?72,$J(TOT,6,2),!
166 W !,"Total 910 Charges:",?72,$J(+$G(TOT(910)),6,2),!
167 W !,"Total Station FCP Charges:",?72,$J(TOT-$G(TOT(910)),6,2),!
168 W:SUSP !,"Total Suspended Charges:",?72,$J(SUSP,6,2),!
169 Q
170ITEMO() ; Select action (A/E/D/Z)
171 K DIR
172 S DIR(0)="SBO^A:Add;D:Delete;E:Edit;Z:Zero"
173 S DIR("A")="Select ACTION" D ^DIR
174 Q Y
175 Q
176ITEMA ; Add an item
177 S ITEM=""
178 K DIC S DIC="^RMPR(661,",DIC(0)="AEQMZ" D ^DIC Q:Y<0!$$QUIT
179 S NEW=+Y
180 K DD,DO D SDICE S DIC(0)="LN" S X=NEW
181 D FILE^DICN Q:Y<0!$$QUIT
182 S DA=+Y,DR="2;9" D ^DIE I $$EQUIT S DIK=DIE D WAK Q
183 ;S FCP=$$GETFCP^RMPOBILU I $$QUIT!(FCP<0) S DIK=DIE D WAK Q
184 ;S DR="3///"_$P(FCP,U,2) D ^DIE I $$EQUIT S DIK=DIE D WAK Q
185 ;S ITEM=DA,IEN=$G(IEN)+1,IEN(IEN)=ITEM
186 S IEN=$G(IEN)+1,IEN(IEN)=DA,ITEM=IEN
187 Q
188SDICE ; Set DIC,DIE,DA for adding Trx items
189 K DIC,DIE,DA
190 S ZV=",""V"","
191 S DA(1)=RMPODFN,DA(2)=RMPOVDR,DA(3)=RMPORVDT,DA(4)=RMPOXITE
192 S DIC="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_ZV_DA(1)_",1,"
193 S DIE=DIC
194 Q
195ITEMS ; Select an item
196 I IEN=1 S ITEM=1 Q
197 K DIR
198 S ITEM=""
199 S DIR(0)="NO^1:"_IEN,DIR("A")="Select an ITEM"
200 S DIR("?")="Note: You cannot select POSTED items"
201 M DIR("?")=ITM
202 D ^DIR Q:Y'>0!$$QUIT
203 I $D(POSTED(+Y)) D G ITEMS
204 . W !,$C(7)_"Item "_(+Y)_" has been POSTED!"
205 S ITEM=+Y I $P($G(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,1,ITEM,0)),U,8)="Y" S PITM=ITEM
206 S BACKPTR=$P($G(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN,1,ITEM,0)),U,13)
207 I $G(BACKPTR),$D(^RMPR(665,RMPODFN,"RMPOC",BACKPTR,0)),$P(^RMPR(665,RMPODFN,"RMPOC",BACKPTR,0),U,11)="Y" S PITM=ITEM
208 Q
209ITEME ; Edit an item
210 K DR D SDICE
211 S DIE("NO^")="BACK"
212 S DA=IEN(ITEM),DR="1;7;S Z1=X;5;S Z2=X;4" D ^DIE Q:$$EQUIT
213SACK S DR="10;S Z3=X" D ^DIE Q:$$EQUIT
214 I Z3>(Z1*Z2) D G SACK
215 . W !,"SUSPENDED AMT SHOULD NOT BE GREATER THAN TOTAL AMOUNT!"
216 S DR="11"_$S(+X=0:"///@",1:"") D ^DIE Q:$$EQUIT
217 S DR="6///"_((Z1*Z2)-Z3) D ^DIE Q:$$EQUIT
218 S DFCP=$P(^RMPO(665.72,DA(4),1,DA(3),1,DA(2),"V",DA(1),1,DA,0),U,3)
219 F D Q:(FCP>0)!QUIT
220 . S FCP=$P($$GETFCP^RMPOBILU(DFCP),U,2) Q:$$QUIT
221 . I FCP<0!(FCP="") W $C(7)_"REQUIRED FIELD!"
222 I FCP>0 S DR="3R///"_FCP_";13R;14" D ^DIE Q:$$EQUIT
223 Q
224ITEMZ ; Zero an item
225 K DR D SDICE
226 S DA=IEN(ITEM),DR="5///0;6///0;10///0;11///@" D ^DIE Q:$$EQUIT
227 Q
228ITEMK ; Delete an item
229 D SDICE
230 S RMDIC=DIC_IEN(ITEM)_",0)",RMIT=$G(@RMDIC),PITM=$P(RMIT,U,8)
231 I PITM="Y" D Q
232 . W !,"Can't delete PRIMARY ITEM!"
233 K DIR S DIR(0)="Y",DIR("A")="Are you SURE you want to delete this item"
234 S DIR("B")="NO" D ^DIR Q:Y'>0
235 K DIK,DA D SDICE S DIK=DIC,DA=IEN(ITEM)
236WAK D ^DIK W " ...deleted!"
237 Q
Note: See TracBrowser for help on using the repository browser.