source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOBIL0.m

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

initial load of WorldVistAEHR

File size: 6.4 KB
Line 
1RMPOBIL0 ;EDS/MDB/HINES CIOFO/HNC - HOME OXYGEN BILLING TRANSACTIONS ;7/24/98 07:34
2 ;;3.0;PROSTHETICS;**29,46,50**;Feb 09, 1996
3 ;
4 ; ODJ - patch 50 - 7/25/00 fix DIR date call in PREBILL sub. so as to
5 ; interpret 2 digit entry as month
6 ; (FM interpets this as year)
7 ;
8OLD ; Enter from top (OLD code)
9 ;
10 D MAIN ; D ^RMPOBIL1
11 ;Q:'$D(RMPODATE)!'$D(RMPOVDR)!'$D(RMPOXITE)!QUIT
12 I '$D(RMPODATE)!'$D(RMPOVDR)!'$D(RMPOXITE)!QUIT D EXIT Q
13 K DIC,DIR,DIR,DD,DA,DR,DO ;CLEANUP FOR L/M
14 D EN^RMPOLM ; -- List manager code
15 D ACCEPT^RMPOPST3,EXIT
16 Q
17MAIN ; Proper entry point
18 D HOME^%ZIS
19 S QUIT=0
20 D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
21 D CKSITE
22 D MONTH("AEQLMZ") Q:$D(RMPODATE)=0!QUIT
23 D VENDOR("AEQLMZ") Q:$D(RMPOVDR)=0!QUIT
24 ;Generate Vendor/Month of transactions
25 I $O(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,0))="V" Q
26 D GEN1
27 Q
28VENDOR(LAYGO) ;Select Vendor
29 ;
30 K DIC,DA,RMPOVDR
31 S DA(2)=RMPOXITE,DA(1)=RMPORVDT
32 S DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
33 S DIC("P")=$P(^DD(665.723,1,0),U,2)
34 S DIC(0)=$G(LAYGO,"AEQMZ") D ^DIC Q:(Y<0)!$$QUIT
35 S RMPOVDR=+Y
36 ;S RMPOVDR=$P(Y,U,2) ; PER ANALYST
37 I $P(Y,U,3)>0 D
38 . S DIE=DIC,DA=+Y,DR="1///NOW" D ^DIE
39 Q
40CKSITE ;Set up Site in Billing if it is not there
41 I '$D(^RMPO(665.72,RMPOXITE,0)) D
42 . K DIC,DD,DO,DA
43 . S (DINUM,X)=RMPOXITE,DIC="^RMPO(665.72,",DIC(0)="L" D FILE^DICN
44 Q
45MONTH(LAYGO) ;Determine Billing Month
46 ;
47 K DIC,DA,RMPODATE
48 S DA(1)=RMPOXITE,DIC="^RMPO(665.72,"_DA(1)_",1,"
49 S DIC("P")=$P(^DD(665.72,1,0),U,2)
50 S DIC(0)=$G(LAYGO,"AEMQZ") D ^DIC Q:(Y<0)!$$QUIT
51 S RMPODATE=+Y,RMPOMTH=Y(0,0)
52 S RMPORVDT=RMPODATE
53 Q
54QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
55 ;
56BUILDM ; BUILD MONTH
57 ; Set up Month
58 Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT)) ; ALREADY DONE..
59 K DIC,DA
60 S X=RMPODATE,DINUM=RMPORVDT
61 S DA(1)=RMPOXITE,DIC(0)="L"
62 S DIC="^RMPO(665.72,"_DA(1)_",1,",DIC("P")=$P(^DD(665.72,1,0),U,2)
63 D FILE^DICN
64 Q
65GEN1 ; ALL PATIENTS FOR A GIVEN VENDOR
66 W !,"Generating "_RMPOMTH_" billing transactions for "
67 W $$VDRNM^RMPOPED(RMPOVDR),!!,"This may take a while..."
68 ;
69 ; D BUILDM
70 ;Copy Patient Boiler-plates
71 ;fix to get ALL patients from same activation date
72 S (ACTIVDT,RMPODFN)=0
73 F S ACTIVDT=$O(^RMPR(665,"AHO",ACTIVDT)) Q:ACTIVDT'>0 D
74 . S RMPODFN=0
75 . F S RMPODFN=$O(^RMPR(665,"AHO",ACTIVDT,RMPODFN)) Q:RMPODFN'>0 D:$$OK2BLD>0 GEN2
76 K DIR S DIR(0)="E" D ^DIR Q:$$QUIT
77 Q
78GEN2 ;INNER LOOP
79 ;W !,RMPODFN
80 S ZXITM=0
81 F S ZXITM=$O(^RMPR(665,RMPODFN,"RMPOC",ZXITM)) Q:ZXITM'>0 D
82 . S ZX1=$G(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0))
83 . Q:$P(ZX1,U,2)'=RMPOVDR
84 . D BUILDP,BUILDI
85 Q
86OK2BLD(VENDOR) ; Determine whether to include trx for RMPODFN
87 ;
88 ; Do NOT process if not at correct site.
89 Q:$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,7)'=RMPOXITE -1
90 ;
91 ; Do NOT process if no Boiler-plate
92 Q:'$D(^RMPR(665,RMPODFN,"RMPOA")) -2
93 ;
94 ; Do NOT process if Inactivation date less the billing date.
95 S RMPOINDT=$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,3)
96 I $G(RMPOINDT) Q:RMPOINDT<RMPODATE -3
97 ;Q:$P($G(^RMPR(665,RMPODFN,"RMPOA")),U,3) -3
98 ;
99 ; Do NOT process if no Rx
100 Q:'$D(^RMPR(665,RMPODFN,"RMPOB",0)) -4
101 ;
102 ; 1st find correct Rx
103 S RMPORX=$O(^RMPR(665,RMPODFN,"RMPOB","B"),-1)
104 Q:'RMPORX -5
105 ;
106 ; Quit if the Rx Expiration Date is before the billing period
107 Q:$P(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3)<(RMPODATE) -6
108 ;
109 ; Quit if there are no items.
110 Q:$O(^RMPR(665,RMPODFN,"RMPOC",0))'>0 -7
111 ;
112 I $G(VENDOR)>0 Q $$VDRSTAT(VENDOR)
113 Q 1
114VDRSTAT(VDR) ;
115 ;
116 S ZXITM=0,FOUND=0
117 F S ZXITM=$O(^RMPR(665,RMPODFN,"RMPOC",ZXITM)) Q:ZXITM'>0 D
118 . I $P($G(^RMPR(665,RMPODFN,"RMPOC",ZXITM,0)),U,2)=VDR S FOUND=1
119 Q $S(FOUND=1:1,1:-8)
120 Q
121BUILDV ; Set up the VENDOR multiple
122 Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR)) ; ALREADY DONE...
123 K DA,DIC,DD,DO
124 S DA(2)=RMPOXITE,DA(1)=RMPORVDT,(DINUM,X)=RMPOVDR
125 S DIC="^RMPO(665.72,"_DA(2)_",1,"_DA(1)_",1,"
126 S DIC("P")=$P(^DD(665.723,1,0),U,2),DIC(0)="L"
127 D FILE^DICN
128 Q
129BUILDP ;Now the Patient level
130 Q:$D(^RMPO(665.72,RMPOXITE,1,RMPORVDT,1,RMPOVDR,"V",RMPODFN)) ; DONE
131 K DA,DIC,DD,DO
132 S DA(3)=RMPOXITE,DA(2)=RMPORVDT,DA(1)=RMPOVDR,(DINUM,X)=RMPODFN
133 S DIC("P")=$P(^DD(665.7231,9,0),U,2),DIC(0)="L",ZV=",""V"","
134 S DIC="^RMPO(665.72,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_ZV
135 D FILE^DICN
136 Q
137 ;
138BUILDI ; BUILD ITEM (REQUIRES ZX1 = ENTIRE ITEM NODE FROM FILE #665)
139 ;Finally, set up the item multiple
140 K DA,DIC,DD,DO,DINUM,DIE,DR
141 S DA(4)=RMPOXITE,DA(3)=RMPORVDT,DA(2)=RMPOVDR,DA(1)=RMPODFN
142 S X=$P(ZX1,U),ZV=",""V"","
143 S DIC="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_ZV_DA(1)_",1,"
144 S DIC("P")=$P(^DD(665.72319,1,0),U,2),DIC(0)="L"
145 D FILE^DICN
146 S DIE=DIC,DA=+Y
147 ;Do some calculations
148 ;Multiply the unit cost by the number of units
149 S RMPOTOT=$P(ZX1,U,3)*$P(ZX1,U,4)
150 S RMREMARK=$P(ZX1,U,9)
151 S DR="1////"_$P(ZX1,U,11) ; PRIMARY ITEM
152 S DR=DR_";2////"_$P(ZX1,U,7) ; HCPCS CODE
153 S DR=DR_";3////"_$P(ZX1,U,6) ; FUND CONTROL POINT
154 S DR=DR_";4///^S X=RMREMARK" ; REMARKS
155 S DR=DR_";5///"_$P(ZX1,U,4) ; UNIT COST
156 S DR=DR_";6///"_$J($G(RMPOTOT),1,2) ; TOTAL (QTY X UNIT COST)
157 S DR=DR_";7///"_$P(ZX1,U,3) ; QUANTITY
158 S DR=DR_";9////"_$P(ZX1,U,8) ; ICD-9 CODE
159 S DR=DR_";12////"_ZXITM ; IEN OF ITEM
160 S DR=DR_";13////"_$P(ZX1,U,10) ; ITEM TYPE
161 S DR=DR_";14////"_$P(ZX1,U,5) ; UNIT OF ISSUE
162 D ^DIE
163 Q
164PREBILL ; Proper entry point
165 D HOME^%ZIS
166 S (RMEND,RMPOPRT,QUIT)=0
167 D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
168 D Q:$D(RMPODATE)=0!QUIT
169 . K DIR,RMPODATE
170 . S DIR(0)="D^^I +X>0,+X'>12 S X=$E(100+X,2,3)_$E(DT,2,3) K Y,%DT D ^%DT"
171 . ;S DIR(0)="D"
172 . S DIR("A")="ENTER BILLING MONTH"
173 . D ^DIR Q:$$QUIT!(Y<1)
174 . S RMPODATE=$E(Y,1,5)_"00"
175 . I Y X ^DD("DD") W ?25,Y
176 . Q
177 S DIC="^RMPR(665,",L=0
178 S BY="[RMPO-BILLING-PRESORT]"
179 S FLDS="[RMPO-BILLING-PRESORT]"
180 S DIS(0)="S RMPODFN=D0,Z=$$OK2BLD^RMPOBIL0 I $D(^RMPR(665,RMPODFN,""RMPOA"")) I (Z'=1)&(Z'=-3)&($P(^RMPR(665,RMPODFN,""RMPOA""),U,7)=RMPOXITE)"
181 S DIOEND="I $G(Y)'[U S RMEND=1 S:IOST[""P-"" RMPOPRT=1"
182 D EN1^DIP
183 I RMPOPRT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
184 D EXIT
185 Q
186BLDSTAT(RMPODFN) ;STATUS OF PT FOR GIVEN BUILD
187 ;
188 S OK=$$OK2BLD($G(RMPOVDR))
189 Q:OK=1 "OK"
190 Q:OK=-1 "Different Home Oxygen Contract Location"
191 Q:OK=-2 "No Home Oxygen Information"
192 Q:OK=-3 "Deactivated"
193 Q:OK=-4 "No RX on file"
194 Q:OK=-5 "No RX on file"
195 Q:OK=-6 "RX expires prior to billing period"
196 Q:OK=-7 "No items on file"
197 Q:OK=-8 "No items for vendor"
198 Q "Other Unknown Error"
199 Q
200EXIT ;Kill variables before quitting
201 N RMPR,RMPRSITE D KILL^XUSCLEAN
202 Q
Note: See TracBrowser for help on using the repository browser.