source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOPS23.m@ 1389

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

initial load of WorldVistAEHR
File size: 5.7 KB
Line 
1RMPOPS23 ;HIN/RVD - HOME OXYGEN BILLING - POST TO 2319 ;5/18/99
2 ;;3.0;PROSTHETICS;**29,44,41,110**;Feb 09, 1996;Build 10
3 ;
4 ;This routine will only post records already been posted in IFCAP.
5 ;Patient records are sorted by fund control point (FCP), DFN and
6 ;then post to 2319.
7 Q
8 ;
9POST ;main module to post billing transactions to 2319
10 D HOME^%ZIS S QUIT=0
11 D HOSITE^RMPOUTL0 Q:('$D(RMPOXITE))!QUIT
12 D MONTH^RMPOBIL0() Q:$D(RMPODATE)=0!QUIT
13 D VENDOR^RMPOBIL0() Q:$D(RMPOVDR)=0!QUIT
14 S FIL=665.72,SITE=RMPOXITE,RVDT=RMPODATE,VDR=RMPOVDR,QUIT=0
15 W !,"Processing..." D BUILD
16 I $O(^TMP($J,""))="" W !,"Everything posted okay!!" G EXIT
17 S FCP="" F S FCP=$O(^TMP($J,FCP)) Q:FCP="" F DFN=0:0 S DFN=$O(^TMP($J,FCP,DFN)) Q:DFN'>0 D F660
18 ;K DIR S DIR(0)="FO",DIR("A")="Press any Key to Continue" D ^DIR
19 ;
20EXIT ;
21 K ^TMP($J)
22 ;K DFN,ITM,ITDT,ITNO,PATNAM,PATSSN,LNAM,PATFLG,ITSTR,FCP,LCK,ITOT
23 N RMPRSITE,RMPR D KILL^XUSCLEAN
24 Q
25 ;
26BUILD ;Build array IFCAP with patient transactions to post
27 ;Separate patient individual items by fund control point
28 ;tMP($J) array
29 ; ^TMP($J,FCP)=FCP total^Post flag^error message^purchase card total
30 ; ^TMP($J,FCP,DFN)=patient tot^pat last name_" "_4 digit SSN^post flag^
31 ; IFCAP error message^pat name
32 ; ^TMP($J,FCP,DFN,ITEM)=item tot
33 K ^TMP($J)
34 S DFN=0 F S DFN=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN)) Q:DFN'>0 D
35 . S PATFLG=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
36 . ;check patient post flag
37 . Q:$P(PATFLG,U,3)'="Y"
38 . D DEM^VADPT S PATNAM=VADM(1),PATSSN=VA("BID") ;patient name & ssn
39 . ;lock patient record
40 . S LCK=$$PATLCK() I 'LCK W !,PATNAM," record locked by another user" Q
41 . ;get items not posted for each patient
42 . S ITM=0
43 . F S ITM=$O(^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM)) Q:'ITM D
44 . . S ITDT=^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,1,ITM,0)
45 . . ;check if item posted
46 . . Q:$P(ITDT,U,10)'="Y"
47 . . Q:$P(ITDT,U,16)>0
48 . . S ITNO=$P(ITDT,U),FCP=$P(ITDT,U,3),ITOT=$P(ITDT,U,6)
49 . . I ITOT'>0 Q ;no amount to post
50 . . I FCP="" Q ;no fund control point
51 . . ;set ^TMP($J) array
52 . . S ^TMP($J,FCP)=$S('$D(^TMP($J,FCP)):0.00,1:^TMP($J,FCP))+ITOT
53 . . I $G(^TMP($J,FCP,DFN))="" D
54 . . . S LNAM=$E($P(PATNAM,",")_" ",1,7)
55 . . . S ^TMP($J,FCP,DFN)="^"_LNAM_" "_PATSSN_"^^^"_$E(PATNAM,1,18)
56 . . S $P(^TMP($J,FCP,DFN),U)=+^TMP($J,FCP,DFN)+ITOT,^TMP($J,FCP,DFN,ITM)=ITOT
57 . D UNLKPAT
58 Q
59 ;
60F660 ;Post to file ^RMPR(660 for form 2319
61 S D665A=$G(^RMPR(665,DFN,"RMPOA")) I D665A="" Q
62 D ;AMIS grouper number
63 . L +^RMPR(669.9,RMPOXITE,0):9999 I $T=0 S RMPOG=DT_$P(DT,2,3) Q
64 . S RMPOG=$P(^RMPR(669.9,RMPOXITE,0),U,7),RMPOG=RMPOG-1
65 . S $P(^RMPR(669.9,RMPOXITE,0),U,7)=RMPOG
66 . L -^RMPR(669.9,RMPOXITE,0)
67 S TRXDT=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,0),U,2)
68 S RFCPIEN=$O(^RMPO(665.72,1,1,RMPODATE,2,"B",FCP,0))
69 S SRVORD=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,4)
70 S PAYINF=$P(^RMPO(665.72,RMPOXITE,1,RMPODATE,2,RFCPIEN,0),U,2)
71 S ITM=0 F S ITM=$O(^TMP($J,FCP,DFN,ITM)) Q:ITM'>0 D
72 . S ITMD=$G(^RMPO(665.72,RMPOXITE,1,RMPODATE,1,RMPOVDR,"V",DFN,1,ITM,0))
73 . S RMITEM=$P(ITMD,U,1)
74 . I $G(RMITEM),$D(^RMPR(661,RMITEM,0)) S RITIEN=$P(^RMPR(661,RMITEM,0),U,1)
75 . I ITMD="" Q
76 . I $P(ITMD,U,6)'>0 Q ;nothing posted to IFCAP
77 . S RMCPHC=$P(ITMD,U,2),RMCPT="",RMCPRENT=$P(ITMD,U,18),RMCPSO="C"
78 . S RMCPTY=$P(ITMD,U,14),RMCPQH=$P(ITMD,U,19)
79 . S RMCPT1=$G(^RMPR(661.1,RMCPHC,4))
80 . I RMCPT1["RP",((RMCPTY="R")!(RMCPTY="X")) S RMCPT=RMCPT_"RP,"
81 . I RMCPT1["QH",($G(RMCPQH)) S RMCPT=RMCPT_"QH,"
82 . I (RMCPRENT=1),(RMCPT1["RR") S RMCPT=RMCPT_"RR,"
83 . I RMCPT1["NU",(RMCPT'["RR") S RMCPT=RMCPT_"NU,"
84 . I $L(RMCPT)>2 S RMCLEN=$L(RMCPT),RMCPT=$E(RMCPT,1,RMCLEN-1)
85 . S DIC="^RMPR(660,",DIC(0)="L",X=DT
86 . K DD,DO D FILE^DICN I +Y<0 Q
87 . S D6I=+Y,D6X=D6I_","
88 . K DIE,DA,DR S DA(4)=RMPOXITE,DA(3)=RMPODATE,DA(2)=RMPOVDR,DA(1)=DFN
89 . S DIE="^RMPO(665.72,"_DA(4)_",1,"_DA(3)_",1,"_DA(2)_",""V"","_DA(1)
90 . S DIE=DIE_",1,",DA=ITM,DR="15////^S X=D6I" D ^DIE
91 . S D660(660,D6X,.02)=DFN ;Patient name pointer
92 . S D660(660,D6X,1)=TRXDT ;Request date
93 . S D660(660,D6X,2)=$P(ITMD,U,14) ;Type of transaction
94 . S D660(660,D6X,4)=$P(ITMD,U) ;item
95 . S D660(660,D6X,4.1)=$P(^RMPR(661.1,$P(ITMD,U,2),0),U,4) ;HCPCS
96 . S D660(660,D6X,4.5)=$P(ITMD,U,2) ;PSAS HCPCS
97 . S D660(660,D6X,4.7)=RMCPT ;RMCPT
98 . S D660(660,D6X,5)=$P(ITMD,U,7) ;quantity
99 . S D660(660,D6X,7)=RMPOVDR ;vendor
100 . S D660(660,D6X,8)=RMPO("STA") ;station
101 . S D660(660,D6X,10)=DT ;Delivery date
102 . I $P(PAYINF,U) S D660(660,D6X,11)=9
103 . I $P(PAYINF,U)="P" S D660(660,D6X,11)=14
104 . S D660(660,D6X,23)=SRVORD ;IFCAP transaction number
105 . S D660(660,D6X,12)="C" ;Source
106 . S D660(660,D6X,14)=$P(ITMD,U,6) ;total cost
107 . S D660(660,D6X,16)=$P(ITMD,U,4) ;remarks
108 . S SUSDES=$S($P(ITMD,U,11)'="":"Suspended Amt "_$P(ITMD,U,11)_" ",1:"")
109 . S D660(660,D6X,24)=SUSDES_$P(ITMD,U,12) ;description
110 . S D660(660,D6X,27)=DUZ ;initator
111 . S D660(660,D6X,62)=$P(D665A,U) ;patient category
112 . S D660(660,D6X,63)=$P(D665A,U,5) ;special category
113 . S D660(660,D6X,68)=RMPOG
114 . S D660(660,D6X,78)=$P(ITMD,U,15) ;unit of issue
115 . D FILE^DIE("K","D660","ERR")
116 . I $D(ERR) D
117 . . W !!,"Posting to 2319 for item ",ITM," patient ",DFN," failed."
118 . . W "Posting will be done later"
119 . I '$D(ERR),$D(^DPT(DFN,0)),$D(^PRC(441,RITIEN,0)) D
120 . . W !,"Patient: ",$P(^DPT(DFN,0),U,1)," Item: ",ITM," posted to 2319."
121 K DIC,X,Y
122 Q
123 ;
124PATLCK() ;Lock patient level in ^RMPO(665.72
125 L +^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0):5
126 Q $T
127 ;
128UNLKPAT ;Unlock patient level in ^RMPO(665.72
129 L -^RMPO(FIL,SITE,1,RVDT,1,VDR,"V",DFN,0)
130 Q
131 ;
132QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
Note: See TracBrowser for help on using the repository browser.