source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUK.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RMPRPIUK ;HINCIO/ODJ - PIP CONVERSION UTILITIES (contd) ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** REC - Create initial reconciliations
6 ; These will balance the Patient Issues just created
7REC N RMPRGBL,RMPRS,RMPR6,RMPR11,RMPRDT,X1,X2,X,RMPRTIME,RMPR5,RMPR69
8 N RMPR9
9 I '$D(IO("Q")) D
10 . W !,"Creating balancing reconciliations "
11 . Q
12 S RMPRGBL="^TMP("""_$J_""",""ISS"")"
13REC1 S RMPRGBL=$Q(@RMPRGBL)
14 I $QS(RMPRGBL,2)'="ISS" G RECX
15 I $QS(RMPRGBL,1)'=$J G RECX
16 I '$D(IO("Q")) D
17 . W:$X=79 ! W "."
18 . Q
19 S RMPR11("STATION")=$QS(RMPRGBL,3)
20 S RMPR11("STATION IEN")=RMPR11("STATION")
21 S RMPR11("HCPCS")=$QS(RMPRGBL,4)
22 S RMPR11("ITEM")=$QS(RMPRGBL,5)
23 S RMPR6("LOCATION")=$QS(RMPRGBL,6)
24 S RMPR5("IEN")=RMPR6("LOCATION")
25 S RMPR6("VENDOR")=$QS(RMPRGBL,7)
26 S RMPR6("VENDOR IEN")=RMPR6("VENDOR")
27 S RMPR6("COMMENT")=""
28 S RMPR6("USER")=DUZ
29 S RMPRS=@RMPRGBL
30 S RMPR6("QUANTITY")=$P(RMPRS,"^",1)
31 S RMPR6("VALUE")=$P(RMPRS,"^",2)
32 ;
33 ; ensure initial reconciliation date is the first one
34 S X1=$O(^RMPR(661.6,"XHDS",RMPR11("HCPCS"),""))
35 S X1=$P(X1,".",1)
36 S X2=-2
37 D C^%DTC
38 S RMPRDT=$P(X,".",1)
39 ;
40 ; compute DATE&TIME for initial reconciliation
41 S RMPR6("DATE&TIME")=""
42 F D Q:RMPR6("DATE&TIME")'=""
43 . D NOW^%DTC
44 . S RMPRTIME=RMPRDT_"."_$P(%,".",2)
45 . I $D(^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME)) H (1+$R(3)) Q
46 . L +^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME):0 E H (1+$R(3)) Q
47 . S RMPR6("DATE&TIME")=RMPRTIME
48 . Q
49 ;
50 ; create transaction
51 S RMPR6("SEQUENCE")=1
52 S RMPR6("TRAN TYPE")=9
53 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
54 K RMPR69
55 S RMPR69("TRANS IEN")=RMPR6("IEN")
56 S RMPR69("GAIN/LOSS")=RMPR6("QUANTITY")
57 S RMPR69("GAIN/LOSS VALUE")=RMPR6("VALUE")
58 S RMPRERR=$$CRE^RMPRPIXB(.RMPR69)
59 L -^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPR6("DATE&TIME"))
60 G REC1
61RECX Q
62 ;
63 ;***** BAL - update running balance file
64BAL N RMPR6,RMPR9,RMPRDT,RMPRS,RMPRH,RMPRI,RMPRD,RMPRQ,RMPRV,RMPRX,RMPRY
65 N RMPRIEN,RMPRFME
66 I '$D(IO("Q")) D
67 . W !,"Creating Running Balance file 661.9 "
68 . Q
69 S RMPRS=""
70 F S RMPRS=$O(^RMPR(661.6,"ASTHIDS",RMPRS)) Q:RMPRS="" D
71 . I '$D(IO("Q")) D
72 .. W:$X=79 ! W "."
73 .. Q
74 . S RMPRH=""
75 . F S RMPRH=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH)) Q:RMPRH="" D
76 .. S RMPRI=""
77 .. F S RMPRI=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI)) Q:RMPRI="" D
78 ... Q:'$D(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI))
79 ... S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,""))
80 ... S RMPRQ=0,RMPRV=0,RMPRX=""
81 ... F S RMPRX=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,RMPRD,RMPRX)) Q:RMPRX="" D
82 .... S RMPRY=""
83 .... F S RMPRY=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,RMPRD,RMPRX,RMPRY)) Q:RMPRY="" D
84 ..... S RMPR6=^RMPR(661.6,RMPRY,0)
85 ..... S RMPRQ=RMPRQ+$P(RMPR6,"^",5)
86 ..... S RMPRV=RMPRV+$P(RMPR6,"^",6)
87 ..... Q
88 .... Q
89 ... I RMPRQ<0 S RMPRQ=0
90 ... I RMPRV<0 S RMPRV=0
91 ... K RMPR9,RMPRIEN,RMPRFME
92 ... S RMPR9(661.9,"+1,",.01)=$P(RMPRD,".",1)
93 ... S RMPR9(661.9,"+1,",1)=RMPRH
94 ... S RMPR9(661.9,"+1,",2)=RMPRI
95 ... S RMPR9(661.9,"+1,",4)=RMPRS
96 ... S RMPR9(661.9,"+1,",7)=RMPRQ
97 ... S RMPR9(661.9,"+1,",8)=RMPRV
98 ... D UPDATE^DIE("","RMPR9","RMPRIEN","RMPRFME")
99 ... F S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD)) Q:RMPRD="" D
100 .... S RMPRX=""
101 .... F S RMPRX=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD,RMPRX)) Q:RMPRX="" D
102 ..... S RMPRY=""
103 ..... F S RMPRY=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD,RMPRX,RMPRY)) Q:RMPRY="" D
104 ...... S RMPR6=^RMPR(661.6,RMPRY,0)
105 ...... S RMPRQ=RMPRQ-$P(RMPR6,"^",5)
106 ...... S RMPRV=RMPRV-$P(RMPR6,"^",6)
107 ...... Q
108 ..... Q
109 .... K RMPR9,RMPRIEN,RMPRFME
110 .... I RMPRQ<0 S RMPRQ=0
111 .... I RMPRV<0 S RMPRV=0
112 .... S RMPR9(661.9,"+1,",.01)=$P(RMPRD,".",1)
113 .... S RMPR9(661.9,"+1,",1)=RMPRH
114 .... S RMPR9(661.9,"+1,",2)=RMPRI
115 .... S RMPR9(661.9,"+1,",4)=RMPRS
116 .... S RMPR9(661.9,"+1,",7)=RMPRQ
117 .... S RMPR9(661.9,"+1,",8)=RMPRV
118 .... D UPDATE^DIE("","RMPR9","RMPRIEN","RMPRFME")
119 .... Q
120 ... Q
121 .. Q
122 . Q
123BALX Q
Note: See TracBrowser for help on using the repository browser.