source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI03.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1RMPRPI03 ;HINCIO/ODJ - PIP Report APIs ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; THIS - returns a ^TMP array structured as follows:-
6 ; ^TMP($J,N,H,I,S)=data (^ delimiter)
7 ;
8 ; where N = ^TMP array name (eg. RMPRPI03)
9 ; H = HCPCS code (eg. L5000)
10 ; A = Item name
11 ; I = Item number (eg. 1)
12 ; S = Sequence (1,2,etc)
13 ;
14 ; data pc 1 = Date
15 ; 2 = Time
16 ; 3 = Opening Balance
17 ; 4 = Closing Balance
18 ; 5 = Quantity
19 ; 6 = Value
20 ; 7 = Transaction Type desc.
21 ; 8 = Patient Name (if patient issue, else null)
22 ; 9 = Patient SSN (if patient issue, else null)
23 ; 10 = User name
24 ;
25THIS(RMPRNM,RMPRSTN,RMPRSDT,RMPREDT,RMPRHCPC) ;
26 N RMPRERR,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPR11
27 N RMPROBAL,RMPRCBAL,RMPRSEQ,RMPRRX,RMPRFMDT,RMPR60,RMPR69
28 N VA,VADM,DFN
29 S RMPRERR=0
30 I $G(RMPRNM)="" S RMPRNM="RMPRPI03"
31 I $G(RMPRSTN)="" S RMPRERR=1 G THISX
32 I '$D(RMPRHCPC) S RMPRHCPC="*"
33 K ^TMP($J,RMPRNM)
34 S RMPRH=""
35THIS1 S RMPRH=$O(RMPRHCPC(RMPRH))
36 I RMPRH="" G THISX
37 K RMPR
38 S RMPR("HCPCS")=RMPRH
39THIS1A S RMPR("DATE&TIME")=RMPRSDT
40 S RMPRERR=$$SRCH^RMPRPIXA(.RMPR,"XHDS","DATE&TIME",1,,.RMPREOF)
41 I RMPRERR G THISX
42 I RMPREOF G THIS1
43 I $G(RMPRHCPC)'="*",RMPR("HCPCS")'=RMPRH G THIS1
44THIS2 S RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","",1,.RMPROLD,.RMPREOF)
45 I RMPRERR G THISX
46 I RMPREOF G THISX
47 I RMPROLD("HCPCS")'=RMPR("HCPCS") G:$G(RMPRHCPC)'="*" THIS1 G THIS1A
48 I RMPR("DATE")>RMPREDT G:$G(RMPRHCPC)="*" THIS3 G THIS1
49 S RMPRFMDT=RMPR("DATE")
50 K RMPRE
51 M RMPRE=RMPR
52 S RMPRERR=$$GET^RMPRPIX6(.RMPRE)
53 I RMPRERR G THISX
54 S RMPRERR=$$STNIEN^RMPRPIX6(.RMPRE)
55 I RMPRERR G THISX
56 I RMPRE("STATION IEN")'=RMPRSTN G THIS2
57 K RMPR11
58 S RMPR11("STATION")=RMPRSTN
59 S RMPR11("HCPCS")=RMPR("HCPCS")
60 S RMPR11("ITEM")=RMPRE("ITEM")
61 S RMPRERR=$$GET^RMPRPIX1(.RMPR11)
62 I '$D(RMPR11("DESCRIPTION")) S RMPR11("DESCRIPTION")="NO DESCRIPTION"
63 S RMPRSEQ=$O(^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),""),-1)
64 I RMPRSEQ'="" D
65 . S RMPROBAL=$P(^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ),"^",4)
66 . Q
67 E D
68 . K RMPRRX
69 . S RMPRRX("STA")=RMPRSTN
70 . S RMPRRX("HCP")=RMPR("HCPCS")
71 . S RMPRRX("ITE")=RMPRE("ITEM")
72 . S RMPRRX("RDT")=RMPRSDT
73 . S RMPROBAL=$$SQTY^RMPRPIXJ(.RMPRRX)
74 . Q
75 S RMPRERR=$$TFLOW^RMPRPIX6(.RMPRE)
76 I RMPRE("TRAN FLOW")="+" D
77 . S RMPRCBAL=RMPROBAL+RMPRE("QUANTITY")
78 . Q
79 I RMPRE("TRAN FLOW")="-" D
80 . S RMPRCBAL=RMPROBAL-RMPRE("QUANTITY")
81 . Q
82 I RMPRE("TRAN FLOW")="=" D
83 . K RMPR69
84 . S RMPR69("TRANS IEN")=RMPRE("IEN")
85 . S RMPRERR=$$GET^RMPRPIXB(.RMPR69)
86 . I '$D(RMPR69("GAIN/LOSS")) S (RMPRE("QUANTITY"),RMPRE("VALUE"),RMPROBAL,RMPRCBAL)=0 Q
87 . S RMPRCBAL=RMPROBAL+RMPR69("GAIN/LOSS")
88 . S RMPRE("QUANTITY")=RMPR69("GAIN/LOSS")
89 . S RMPRE("VALUE")=RMPR69("GAIN/LOSS VALUE")
90 . Q
91 I RMPRE("TRAN FLOW")="" D
92 . S RMPRCBAL=RMPROBAL
93 . Q
94 S RMPRSTR=""
95 S $P(RMPRSTR,"^",1)=$E(RMPRFMDT,4,5)_"/"_$E(RMPRFMDT,6,7)_"/"_$E(RMPRFMDT,2,3)
96 S $P(RMPRSTR,"^",2)=RMPRE("TIME")
97 S $P(RMPRSTR,"^",3)=RMPROBAL
98 S $P(RMPRSTR,"^",4)=RMPRCBAL
99 S $P(RMPRSTR,"^",5)=RMPRE("QUANTITY")
100 S $P(RMPRSTR,"^",6)=RMPRE("VALUE")
101 S $P(RMPRSTR,"^",7)=RMPRE("TRAN TYPE")
102 S $P(RMPRSTR,"^",10)=RMPRE("USER")
103 K RMPR60
104 S RMPRERR=$$IEN60^RMPRPIX6(.RMPRE,.RMPR60)
105 I 'RMPRERR,$G(RMPR60("IEN"))'="" D
106 . S DFN=$P($G(^RMPR(660,RMPR60("IEN"),0)),"^",2)
107 . D DEM^VADPT
108 . S $P(RMPRSTR,"^",8)=$G(VADM(1))
109 . S $P(RMPRSTR,"^",9)=$P($G(VADM(2)),"^",2)
110 . Q
111 S ^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ+1)=RMPRSTR
112 G THIS2
113THIS3 S RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","HCPCS",1,.RMPROLD,.RMPREOF)
114 I RMPREOF G THISX
115 G THIS1A
116THISX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.