source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU3.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1RMPRPIU3 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT DELETE UILITY ;3/8/01
2 ;;3.0;PROSTHETICS;**61,117**;Feb 09, 1996
3 Q
4 ;
5 ; DEL - Delete a Stock 'Issue to Patient' Transaction
6 ; Deletes the 2319 record in file 660
7 ; the patient issue record in 661.63
8 ; Creates a type 8 'Return In' transaction
9 ; Brings back issue quantity into stock
10 ; Updates running balance
11 ;
12 ; Inputs:
13 ; RMPR60 - array of data fields for 660 file record...
14 ; RMPR60("IEN") must be set to the ien of 660 rec.
15 ; being deleted.
16 ; RMPR60("IEN") - IEN of 660 record being deleted
17 ;
18 ; Outputs:
19 ; RMPRERR - 0 - no problems
20 ; 11 - problem reading 660 rec. to delete
21 ; 12 - problem reading 661.6 rec. to delete
22 ; 29 - problem with 660 rec. delete
23 ; 39 - problem with 661.6,661.63 rec. delete
24 ; 49 - problem with 661.6 return rec. creation
25 ; 59 - problem with bringing back into stock
26 ;
27DEL(RMPR60) ;
28 N RMPRERR,RMPRC60,RMPRC60I,RMPRC1,RMPRC1I,RMPRC6,RMPRC6I
29 N RMPRC5,RMPRC11,RMPRRET,RMPR7R
30 S RMPRERR=0
31 ;
32 ; STEP 1
33 ; read in existing 660 and 661.6 recs.
34 S RMPRC60("IEN")=RMPR60("IEN")
35 S RMPRERR=$$GET^RMPRPIX2(.RMPRC60,.RMPRC1) ;read in current 660 rec
36 I RMPRERR S RMPRERR=11 G DELX
37 S RMPRERR=$$ETOI^RMPRPIX2(.RMPRC60,.RMPRC1,.RMPRC60I,.RMPRC1I)
38 I RMPRERR S RMPRERR=11 G DELX
39 S RMPRC6("IEN")=RMPRC60("TRANS IEN")
40 S RMPRERR=$$GET^RMPRPIX6(.RMPRC6) ;read in current 661.6 rec
41 I RMPRERR S RMPRERR=12 G DELX
42 S RMPRERR=$$ETOI^RMPRPIX6(.RMPRC6,.RMPRC6I)
43 I RMPRERR S RMPRERR=12 G DELX
44 S RMPRC5("IEN")=RMPRC6I("LOCATION")
45 S RMPRC11("STATION")=RMPRC6I("STATION")
46 S RMPRC11("STATION IEN")=RMPRC6I("STATION")
47 S RMPRC11("HCPCS")=RMPRC6I("HCPCS")
48 S RMPRC11("ITEM")=RMPRC6I("ITEM")
49 S RMST1=RMPRC6I("STATION"),RMHC1=RMPRC6I("HCPCS")
50 S RMLO1=RMPRC6I("LOCATION"),RMIT1=RMPRC6I("ITEM")
51 ;
52 ; STEP 2
53 ; Delete the 660 record
54 S RMPRERR=$$DEL^RMPRPIX2(.RMPR60)
55 I RMPRERR S RMPRERR=29 G DELX ;err 29 if 660 delete problem
56 ;
57 ; STEP 3
58 ; get 661.63 information
59 K RMDTTIM
60 S RM6613I=$O(^RMPR(661.63,"B",RMPRC6("IEN"),0))
61 I $G(RM6613I),$D(^RMPR(661.63,RM6613I,0)) D
62 .S RM63DAT=$G(^RMPR(661.63,RM6613I,0))
63 .S RMDTTIM=$P(RM63DAT,U,6)
64 .Q:'$G(RMDTTIM)
65 .S RMPRRET("DATE&TIME")=RMDTTIM
66 .S RMPRRET("QUANTITY")=$P(RM63DAT,U,12)
67 .S RMPRRET("VALUE")=$P(RM63DAT,U,10)
68 .S RMPRRET("UNIT")=$P(RM63DAT,U,11)
69 .S RMPRRET("VENDOR")=$P(RM63DAT,U,9)
70 .S RMPRRET("LOCATION")=$P(RM63DAT,U,8)
71 ; Delete 661.63 Patient Issue record
72 S RMPRERR=$$DEL^RMPRPIX3(.RMPRC6)
73 I RMPRERR S RMPRERR=39
74 ;
75 ; STEP 4
76 ; Create a Return to Stock Record
77 S RMPRRET("SEQUENCE")=1
78 S RMPRRET("TRAN TYPE")=8
79 S RMPRRET("COMMENT")=""
80 S RMPRRET("USER")=$G(DUZ)
81 I '$D(RMPRRET("QUANTITY")) S RMPRRET("QUANTITY")=RMPRC60I("QUANTITY")
82 I '$D(RMPRRET("VALUE")) S RMPRRET("VALUE")=$G(RMPRC60I("COST"))
83 I '$D(RMPRRET("UNIT")) S RMPRRET("UNIT")=$G(RMPRC60I("UNIT"))
84 I '$D(RMPRRET("VENDOR")) S RMPRRET("VENDOR")=$G(RMPRC60I("VENDOR"))
85 I '$D(RMPRRET("LOCATION")) S RMPRRET("LOCATION")=$G(RMPRC5("IEN"))
86 S RMPRERR=$$CRE^RMPRPIX6(.RMPRRET,.RMPRC11)
87 I RMPRERR S RMPRERR=49
88 ;
89 ; STEP 5
90 ; Bring back into current stock
91 D NOW^%DTC
92 S RMPR7R("STATION")=RMPRC11("STATION")
93 S RMPR7R("HCPCS")=RMPRC11("HCPCS")
94 S RMPR7R("ITEM")=RMPRC11("ITEM")
95 S RMPR7R("LOCATION")=RMPRC5("IEN")
96 S RMPR7R("VENDOR")=RMPRRET("VENDOR")
97 S RMPR7R("DATE&TIME")=% S:$G(RMPRRET("DATE&TIME"))'="" RMPR7R("DATE&TIME")=RMPRRET("DATE&TIME")
98 S RMPR7R("SEQUENCE")=RMPRRET("SEQUENCE")
99 S RMPR7R("QUANTITY")=RMPRRET("QUANTITY")
100 S RMPR7R("VALUE")=RMPRRET("VALUE")
101 S RMPR7R("UNIT")=$G(RMPRRET("UNIT"))
102 I $G(RMDTTIM),$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=71
103 .S RMPR7R("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM,1,0))
104 .I '$G(RMPR7R("IEN")) S RMPRERR=1 Q
105 .S RMDA7=$G(^RMPR(661.7,RMPR7R("IEN"),0))
106 .S RMDAVAL=$P(RMDA7,U,8),RMDAQUA=$P(RMDA7,U,7)
107 .S RMPR7R("QUANTITY")=RMPR7R("QUANTITY")+RMDAQUA
108 .S RMPR7R("VALUE")=RMPR7R("VALUE")+RMDAVAL
109 .S RMPRERR=0
110 .S RMPR7R("DATE&TIME")=RMDTTIM
111 .S RMPRERR=$$UPD^RMPRPIX7(.RMPR7R,.RMPRC11)
112 I $G(RMDTTIM),'$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=72
113 .S RMPRERR=0
114 .S RMPR7R("DATE&TIME")=RMDTTIM
115 .S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11)
116 I '$G(RMDTTIM) D I RMPRERR S RMPRERR=73
117 .;create an entry
118 .S RMPRERR=0
119 .S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11)
120 ;update 661.9
121 S RMPR9("STA")=RMPRC6I("STATION")
122 S RMPR9("HCP")=RMPRC6I("HCPCS")
123 S RMPR9("ITE")=RMPRC6I("ITEM")
124 S RMPR9("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
125 S RMPR9("TQTY")=RMPRC6I("QUANTITY")
126 S RMPR9("TCST")=RMPRC6I("VALUE")
127 S RMPRERR=0
128 S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)
129 I RMPRERR S RMPRERR=59
130 ;
131 ;exit
132DELX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.