- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYF.m
r613 r623 1 RMPRPIYF ;PHX/RFM,RVD-EDIT ISSUE FROM STOCK ;8/2/02 07:27 2 ;;3.0;PROSTHETICS;**61,117,139**;Feb 09, 1996;Build 4 3 ; RVD #61 - phase III of PIP enhancement. 4 ; 5 ;Per VHA Directive 10-93-142, this routine should not be modified. 6 COST ; 7 S RMACNT=RMPRCOST*$P(R1(0),U,7),$P(R3("D"),U,16)=RMACNT,$P(R1(0),U,16)=RMACNT 8 ; 9 DATE S:$P(R1(1),U,8) DIR("B")=$P(R1("D"),U,8) S DIR("A")="DATE OF SERVICE",DIR(0)="660,39" D ^DIR K DIR 10 G:X["^" CO^RMPRPIYE G:$D(DTOUT) EXIT I $P(R1(1),U,8)&(X="@") W !,"This field is mandatory!!!",! G DATE 11 I X="" W !,"This field is mandatory!!!",! G DATE 12 S $P(R1(1),U,8)=Y,Y=$P(R1(1),U,8) D DD^%DT S $P(R1("D"),U,8)=Y 13 ; 14 REQ S DIR(0)="660,9" S:$P(R1(0),U,11)'="" DIR("B")=$P(R1(0),U,11) D ^DIR G:$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT 15 I X["^" W !,"Jumping not allowed!" G REQ 16 I $P(R1(0),U,11)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,11)="" G LOT 17 S $P(R1(0),U,11)=X 18 ; 19 LOT K DIR S DIR(0)="660,21" S:$P(R1(0),U,24)'="" DIR("B")=$P(R1(0),U,24) D ^DIR G:$D(DUOUT) CO^RMPRPIYE 20 I X["^" W !,"Jumping not allowed!" G LOT 21 I $P(R1(0),U,24)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,24)="" G REMA 22 S $P(R1(0),U,24)=X 23 ; 24 REMA K DIR S DIR(0)="660,16" S:$P(R1(0),U,18)'="" DIR("B")=$P(R1(0),U,18) D ^DIR G:$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT 25 I X["^" W !,"Jumping not allowed!" G REMA 26 I $P(R1(0),U,18)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,18)="" G CC 27 S $P(R1(0),U,18)=X 28 CC G CO^RMPRPIYE 29 ; 30 POST ;POSTS EDITED TRANSACTION TO 660 31 W !,"Posting...." 32 K RMPR60,RMDTTIM,RMPR63 33 S RMPR60("IEN")=RMPRIEN,RMFLG=0 34 ;RMPR60 -array of data fields for 660 file record. 35 D SET60^RMPRPIYE 36 ;get 661.6 & 661.63 patient issue 37 S (RMPR6("IEN"),RMIEN6)=$P(R1(1),U,5) 38 I $G(RMIEN6),$D(^RMPR(661.6,RMIEN6,0)) D 39 .S RMDAT6=$G(^RMPR(661.6,RMIEN6,0)) 40 .S RMIEN63=$O(^RMPR(661.63,"B",RMIEN6,0)) 41 .I $G(RMIEN63),$D(^RMPR(661.63,RMIEN63,0)) D 42 ..S RMDAT63=$G(^RMPR(661.63,RMIEN63,0)),RMPR63("IEN")=RMIEN63 43 ..S (RMPRRET("DATE&TIME"),RMDTTIM)=$P(RMDAT63,U,6) 44 ..S RMPRRET("QUANTITY")=$P(RMDAT63,U,12) 45 ..S RMPRRET("HCPCS")=$P(RMDAT63,U,4) 46 ..S RMPRRET("STATION")=$P(RMDAT63,U,7) 47 ..S RMPRRET("ITEM")=$P(RMDAT63,U,5) 48 ..S RMPRRET("VALUE")=$P(RMDAT63,U,10) 49 ..S RMPRRET("UNIT")=$P(RMDAT63,U,11) 50 ..S RMPRRET("VENDOR")=$P(RMDAT63,U,9) 51 ..S RMPRRET("LOCATION")=$P(RMDAT63,U,8) 52 ;only update 660 if no label scan and quantity the same. 53 I '$D(RMPR7I),($P(R1BCK(0),U,7)=RMPR60("QUANTITY")) D UP660 G PCE 54 ;set update flags: 1=new item/diff barcode 2=only quantity changed. 55 I $G(RMDTTIM),$D(RMPR7I("DATE&TIME")),RMDTTIM'=RMPR7I("DATE&TIME") S RMFLG=1 56 I '$G(RMDTTIM),$D(RMPR7I("DATE&TIME")) S RMFLG=1 57 I $P(R1BCK(0),U,7)'=RMPR60("QUANTITY"),'$G(RMFLG) S RMFLG=2 58 ; 59 API ;call API for 660, 661.7, 661.6, 661.63, 661.9 60 ; 61 ;file #660, 661.6, 661.7, 661.63, 661.9 62 I RMFLG=1 D UPDATE 63 I RMFLG=2 D QUAN 64 D UP660 65 I $G(RMPRERR) W !!,"*** ERROR in 2319 UPDATE, Please notify your IRM..IEN = ",$G(RMPR60("IEN")),!! H 3 66 ; 67 PCE ;update PCE data 68 I $D(^RMPR(660,RMPR60("IEN"),10)),$P(^RMPR(660,RMPR60("IEN"),10),U,12) D 69 .S RMCHK=0 70 .S RMCHK=$$SENDPCE^RMPRPCEA(RMPR60("IEN")) 71 .I RMCHK'=1 W !!,"*** ERROR in PCE UPDATE, Please notify your IRM..IEN = ",RMPR60("IEN"),!! H 3 72 ; 73 ;end posting (edit 2319) 74 G EXIT 75 ; 76 DEL1 ;ENTRY POINT TO DELETE AN ISSUE FROM STOCK 77 ;** MOVED TO RMPRPIFD DUE TO SIZE CONSTRAINTS 78 G DEL1^RMPRPIFD 79 EXIT ;KILL VARIABLES AND EXIT ROUTINE 80 I $G(RMPRIEN),$D(^RMPR(660,RMPRIEN)) L -^RMPR(660,RMPRIEN) 81 K ^TMP($J) N RMPRSITE,RMPR D KILL^XUSCLEAN 82 Q 83 ; 84 UP660 ;update 660 85 S RMPR60("IEN")=RMPRIEN 86 S RMPRERR=0 87 S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11I) 88 I $G(RMPRERR) W !,"*** Error in API RMPRPIX2, ERROR = ",RMPRERR,!,"*** Please inform your IRM !!",! 89 Q 90 ; 91 UPDATE ;update the new entries AND delete old data 92 S RMNEWHC=RMPR11I("HCPCS") 93 S RMNEWIT=RMPR11I("ITEM") 94 I $G(RMPR6("IEN")) S RMPR60("IEN")=RMPR6("IEN") D 95 .S RMPRERR=$$UPD^RMPRPIX6(.RMPR60,.RMPR11I) 96 .I $G(RMPR63("IEN")) S RMPRERR=$$UPALL^RMPRPIX3(.RMPR60,.RMPR63,.RMPR11I) 97 .I '$G(RMPR63("IEN")) S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11I) 98 I '$G(RMPR6("IEN")) D 99 .S RMPRERR=$$CRE^RMPRPIX6(.RMPR60,.RMPR11I) 100 .S (RMPR60("IEN6"),RMPR6("IEN"))=$G(RMPR60("IEN")) 101 .S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11I) 102 ;create a return stock record 103 S RMPR11I("HCPCS")=$G(RMPRRET("HCPCS")) 104 S RMPR11I("ITEM")=$G(RMPRRET("ITEM")) 105 S RMPRRET("SEQUENCE")=1 106 S RMPRRET("TRAN TYPE")=8 107 S RMPRRET("COMMENT")="STOCK ISSUE EDIT" 108 S RMPRRET("USER")=$G(DUZ) 109 I '$D(RMPRRET("QUANTITY")) S RMPRRET("QUANTITY")=RMPR60("QUANTITY") 110 I '$D(RMPRRET("VALUE")) S RMPRRET("VALUE")=RMPR60("COST") 111 I '$D(RMPRRET("UNIT")) S RMPRRET("UNIT")=RMPR60("UNIT") 112 I '$D(RMPRRET("VENDOR")) S RMPRRET("VENDOR")=RMPR60("VENDOR IEN") 113 I '$D(RMPRRET("LOCATION")) S RMPRRET("LOCATION")=$G(RMLO1) 114 I $D(RMPR11I) D I $G(RMPRERR) Q 115 .S RMPRERR=$$CRE^RMPRPIX6(.RMPRRET,.RMPR11I) 116 ;return/update 661.7 117 D BACK Q:$G(RMPRERR) 118 S RMPR11I("HCPCS")=$G(RMNEWHC) 119 S RMPR11I("ITEM")=$G(RMNEWIT) 120 S RMPR7I("QUANTITY")=RMPR60("QUANTITY") 121 S RMPR7I("VALUE")=RMPR60("COST") 122 ;update or create 661.7 entry 123 D UP7 124 S RMPR9("QUANTITY")=RMPR60("QUANTITY") 125 S RMPR9("VALUE")=RMPR60("COST") 126 ;return 661.9 entry 127 I $D(RMDTTIM) D D UP9 128 .S RMPR11I("HCPCS")=RMPRRET("HCPCS") 129 .S RMPR11I("ITEM")=RMPRRET("ITEM") 130 .S RMPR9("QUANTITY")=$P(R1BCK(0),U,7) 131 .S RMPR9("VALUE")=$P(R1BCK(0),U,16) 132 ;deduct the new HCPCS in 661.9 133 S RMPR11I("HCPCS")=RMNEWHC 134 S RMPR11I("ITEM")=RMPR60("ITEM") 135 S RMPR9("QUANTITY")=0-RMPR60("QUANTITY") 136 S RMPR9("VALUE")=0-RMPR60("COST") 137 D UP9 138 Q 139 ; 140 BACK ; Bring back ITEM into current stock. 141 D NOW^%DTC 142 S (RMPR7R("STATION"),RMST1)=RMPR11I("STATION") 143 S (RMPR7R("HCPCS"),RMHC1)=RMPR11I("HCPCS") 144 S (RMPR7R("ITEM"),RMIT1)=RMPR11I("ITEM") 145 S (RMPR7R("LOCATION"),RMLO1)=RMPRRET("LOCATION") 146 S RMPR7R("VENDOR")=RMPRRET("VENDOR") 147 S RMPR7R("DATE&TIME")=% S:$G(RMPRRET("DATE&TIME"))'="" RMPR7R("DATE&TIME")=RMPRRET("DATE&TIME") 148 S RMPR7R("SEQUENCE")=1 149 S RMPR7R("QUANTITY")=RMPRRET("QUANTITY") 150 S RMPR7R("VALUE")=RMPRRET("VALUE") 151 S RMPR7R("UNIT")=$G(RMPRRET("UNIT")) 152 I $G(RMDTTIM),$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=71 Q 153 .S RMPR7R("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM,1,0)) 154 .I '$G(RMPR7R("IEN")) S RMPRERR=1 Q 155 .S RMDA7=$G(^RMPR(661.7,RMPR7R("IEN"),0)) 156 .S RMDAVAL=$P(RMDA7,U,8),RMDAQUA=$P(RMDA7,U,7) 157 .S RMPR7R("QUANTITY")=RMPR7R("QUANTITY")+RMDAQUA 158 .S RMPR7R("VALUE")=RMPR7R("VALUE")+RMDAVAL 159 .S RMPR7R("DATE&TIME")=RMDTTIM 160 .S RMPRERR=$$UPD^RMPRPIX7(.RMPR7R,.RMPR11I) 161 I $G(RMDTTIM),'$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D 162 .S RMPR7R("DATE&TIME")=RMDTTIM 163 .S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPR11I) 164 I '$G(RMDTTIM) S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPR11I) 165 Q 166 ; 167 UP6 ;now update file 661.6 168 S RMPR6("IEN")=$G(RMIEN6) 169 S RMPR6("QUANTITY")=$G(RMPR60("QUANTITY")) 170 S RMPR6("VALUE")=$G(RMPR60("COST")) 171 S RMPRERR=$$UPD^RMPRPIX6(.RMPR6,.RMPR11I) 172 Q 173 ; 174 ; 175 UP63 ;update file 661.63 176 S RMPR6("IEN")=$G(RMIEN6) 177 S RMPR6("LOCATION")=$G(RMPR5("IEN")) 178 S RMPR6("VENDOR")=$G(RMPR60("VENDOR IEN")) 179 S RMPR63("IEN")=$G(RMIEN63) 180 S RMPRERR=$$UPD^RMPRPIX3(.RMPR60,.RMPR63,.RMPR11I) 181 Q 182 ; 183 UP7 ;file #661.7,deduct quantity 184 Q:'$G(RMPR11I("STATION")) 185 S RMPR7I("STATION IEN")=RMPR11I("STATION") 186 S RMPR7I("LOCATION IEN")=$G(RMPR5("IEN")) 187 S RMPR7I("HCPCS")=RMPR11I("HCPCS") 188 S RMPR7I("ITEM")=RMPR11I("ITEM") 189 S:$G(RMPRRET("DATE&TIME")) RMPR7I("DATE&TIME")=RMPRRET("DATE&TIME") 190 S RMPR7I("ISSUED QTY")=$G(RMPR7I("QUANTITY")) 191 S RMPR7I("ISSUED VALUE")=$G(RMPR7I("VALUE")) 192 S RMPRERR=$$FIFO^RMPRPIUB(.RMPR7I) 193 Q 194 UP9 ;file 661.9 195 D NOW^%DTC 196 S RMPR9("STA")=RMPR11I("STATION") 197 S RMPR9("HCP")=RMPR11I("HCPCS") 198 S RMPR9("ITE")=RMPR11I("ITEM") 199 S RMPR9("RDT")=$P(%,".",1) 200 S RMPR9("TQTY")=RMPR9("QUANTITY") 201 S RMPR9("TCST")=RMPR9("VALUE") 202 S RMPERR=$$UPCR^RMPRPIXJ(.RMPR9) 203 Q 204 ; 205 QUAN ;only update quantity 206 ;quit if not in PIP 207 Q:'$G(RMIEN6)!'$D(RMDTTIM)!'$D(RMPRRET) 208 S RMPR11I("STATION")=RMPRRET("STATION") 209 S RMPR11I("HCPCS")=RMPRRET("HCPCS") 210 S RMPR11I("ITEM")=RMPRRET("ITEM") 211 S RMPR5("IEN")=RMPRRET("LOCATION") 212 D UP6,UP63 213 I RMPR60("QUANTITY")>($P(R1BCK(0),U,7)) D D UP7,UP9 214 .S RMPR7I("QUANTITY")=RMPR60("QUANTITY")-($P(R1BCK(0),U,7)) 215 .S RMPR7I("VALUE")=RMPR60("COST")-($P(R1BCK(0),U,16)) 216 .S RMPR9("QUANTITY")=0-($G(RMPR60("QUANTITY"))-$P(R1BCK(0),U,7)) 217 .S RMPR9("VALUE")=0-($G(RMPR60("COST"))-$P(R1BCK(0),U,16)) 218 I RMPR60("QUANTITY")<($P(R1BCK(0),U,7)) D D BACK,UP9 219 .S RMPR9("QUANTITY")=$P(R1BCK(0),U,7)-$G(RMPR60("QUANTITY")) 220 .S RMPRRET("QUANTITY")=$P(R1BCK(0),U,7)-$G(RMPR60("QUANTITY")) 221 .S RMPR9("VALUE")=$P(R1BCK(0),U,16)-$G(RMPR60("COST")) 222 .S RMPRRET("VALUE")=$P(R1BCK(0),U,16)-$G(RMPR60("COST")) 223 Q 224 ; 225 ERR W !!,"Error encountered while posting to PIP. Patient 10-2319 not deleted!! Please check with your Application Coordinator." H 5 G EXIT 1 RMPRPIYF ;PHX/RFM,RVD-EDIT ISSUE FROM STOCK ;8/2/02 07:27 2 ;;3.0;PROSTHETICS;**61,117**;Feb 09, 1996 3 ; RVD #61 - phase III of PIP enhancement. 4 ; 5 ;Per VHA Directive 10-93-142, this routine should not be modified. 6 COST ; 7 S RMACNT=RMPRCOST*$P(R1(0),U,7),$P(R3("D"),U,16)=RMACNT,$P(R1(0),U,16)=RMACNT 8 ; 9 DATE S:$P(R1(1),U,8) DIR("B")=$P(R1("D"),U,8) S DIR("A")="DATE OF SERVICE",DIR(0)="660,39" D ^DIR K DIR 10 G:X["^" CO^RMPRPIYE G:$D(DTOUT) EXIT I $P(R1(1),U,8)&(X="@") W !,"This field is mandatory!!!",! G DATE 11 I X="" W !,"This field is mandatory!!!",! G DATE 12 S $P(R1(1),U,8)=Y,Y=$P(R1(1),U,8) D DD^%DT S $P(R1("D"),U,8)=Y 13 ; 14 REQ S DIR(0)="660,9" S:$P(R1(0),U,11)'="" DIR("B")=$P(R1(0),U,11) D ^DIR G:$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT 15 I X["^" W !,"Jumping not allowed!" G REQ 16 I $P(R1(0),U,11)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,11)="" G LOT 17 S $P(R1(0),U,11)=X 18 ; 19 LOT K DIR S DIR(0)="660,21" S:$P(R1(0),U,24)'="" DIR("B")=$P(R1(0),U,24) D ^DIR G:$D(DUOUT) CO^RMPRPIYE 20 I X["^" W !,"Jumping not allowed!" G LOT 21 I $P(R1(0),U,24)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,24)="" G REMA 22 S $P(R1(0),U,24)=X 23 ; 24 REMA K DIR S DIR(0)="660,16" S:$P(R1(0),U,18)'="" DIR("B")=$P(R1(0),U,18) D ^DIR G:$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT 25 I X["^" W !,"Jumping not allowed!" G REMA 26 I $P(R1(0),U,18)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,18)="" G CC 27 S $P(R1(0),U,18)=X 28 CC G CO^RMPRPIYE 29 ; 30 POST ;POSTS EDITED TRANSACTION TO 660 31 W !,"Posting...." 32 K RMPR60,RMDTTIM,RMPR63 33 S RMPR60("IEN")=RMPRIEN,RMFLG=0 34 ;RMPR60 -array of data fields for 660 file record. 35 D SET60^RMPRPIYE 36 ;get 661.6 & 661.63 patient issue 37 S (RMPR6("IEN"),RMIEN6)=$P(R1(1),U,5) 38 I $G(RMIEN6),$D(^RMPR(661.6,RMIEN6,0)) D 39 .S RMDAT6=$G(^RMPR(661.6,RMIEN6,0)) 40 .S RMIEN63=$O(^RMPR(661.63,"B",RMIEN6,0)) 41 .I $G(RMIEN63),$D(^RMPR(661.63,RMIEN63,0)) D 42 ..S RMDAT63=$G(^RMPR(661.63,RMIEN63,0)),RMPR63("IEN")=RMIEN63 43 ..S (RMPRRET("DATE&TIME"),RMDTTIM)=$P(RMDAT63,U,6) 44 ..S RMPRRET("QUANTITY")=$P(RMDAT63,U,12) 45 ..S RMPRRET("HCPCS")=$P(RMDAT63,U,4) 46 ..S RMPRRET("STATION")=$P(RMDAT63,U,7) 47 ..S RMPRRET("ITEM")=$P(RMDAT63,U,5) 48 ..S RMPRRET("VALUE")=$P(RMDAT63,U,10) 49 ..S RMPRRET("UNIT")=$P(RMDAT63,U,11) 50 ..S RMPRRET("VENDOR")=$P(RMDAT63,U,9) 51 ..S RMPRRET("LOCATION")=$P(RMDAT63,U,8) 52 ;only update 660 if no label scan and quantity the same. 53 I '$D(RMPR7I),($P(R1BCK(0),U,7)=RMPR60("QUANTITY")) D UP660 G PCE 54 ;set update flags: 1=new item/diff barcode 2=only quantity changed. 55 I $G(RMDTTIM),$D(RMPR7I("DATE&TIME")),RMDTTIM'=RMPR7I("DATE&TIME") S RMFLG=1 56 I '$G(RMDTTIM),$D(RMPR7I("DATE&TIME")) S RMFLG=1 57 I $P(R1BCK(0),U,7)'=RMPR60("QUANTITY"),'$G(RMFLG) S RMFLG=2 58 ; 59 API ;call API for 660, 661.7, 661.6, 661.63, 661.9 60 ; 61 ;file #660, 661.6, 661.7, 661.63, 661.9 62 I RMFLG=1 D UPDATE 63 I RMFLG=2 D QUAN 64 D UP660 65 I $G(RMPRERR) W !!,"*** ERROR in 2319 UPDATE, Please notify your IRM..IEN = ",$G(RMPR60("IEN")),!! H 3 66 ; 67 PCE ;update PCE data 68 I $D(^RMPR(660,RMPR60("IEN"),10)),$P(^RMPR(660,RMPR60("IEN"),10),U,12) D 69 .S RMCHK=0 70 .S RMCHK=$$SENDPCE^RMPRPCEA(RMPR60("IEN")) 71 .I RMCHK'=1 W !!,"*** ERROR in PCE UPDATE, Please notify your IRM..IEN = ",RMPR60("IEN"),!! H 3 72 ; 73 ;end posting (edit 2319) 74 G EXIT 75 ; 76 DEL1 ;ENTRY POINT TO DELETE AN ISSUE FROM STOCK 77 K DIR 78 S DIR("A")="Are you sure you want to DELETE this entry",DIR("B")="N",DIR(0)="Y" 79 D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) G EXIT 80 I Y'=1 G CO^RMPRPIYE 81 ; 82 DEL2 ;call API for returning item to PIP 83 S (RMCHK,RMERPCE)=0 84 S RMI68=$P($G(^RMPR(660,RMPRIEN,10)),U,1) I RMI68>0 D I RMERPCE W !!,"** STOCK ISSUE DELETE ABORTED",!! G EXIT 85 .S RMCHK=$$DEL^RMPRPCED(RMPRIEN) 86 .I RMCHK'=0 W !!,"*** ERROR in PCE DELETE, Please notify your IRM..660 IEN = ",RMPRIEN,!! S RMERPCE=1 H 3 87 S RMPR60("IEN")=RMPRIEN 88 S RMCHK=$$DEL^RMPRPIU3(.RMPR60) 89 I $G(RMCHK) W !,"*** Error in API RMPRPIU3, ERROR = ",RMCHK,!,"*** Please inform your IRM !!",! G EXIT 90 ; 91 W $C(7),!?10,"Deleted..." H 1 92 EXIT ;KILL VARIABLES AND EXIT ROUTINE 93 I $G(RMPRIEN),$D(^RMPR(660,RMPRIEN)) L -^RMPR(660,RMPRIEN) 94 K ^TMP($J) N RMPRSITE,RMPR D KILL^XUSCLEAN 95 Q 96 ; 97 UP660 ;update 660 98 S RMPR60("IEN")=RMPRIEN 99 S RMPRERR=0 100 S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11I) 101 I $G(RMPRERR) W !,"*** Error in API RMPRPIX2, ERROR = ",RMPRERR,!,"*** Please inform your IRM !!",! 102 Q 103 ; 104 UPDATE ;update the new entries AND delete old data 105 S RMNEWHC=RMPR11I("HCPCS") 106 S RMNEWIT=RMPR11I("ITEM") 107 I $G(RMPR6("IEN")) S RMPR60("IEN")=RMPR6("IEN") D 108 .S RMPRERR=$$UPD^RMPRPIX6(.RMPR60,.RMPR11I) 109 .I $G(RMPR63("IEN")) S RMPRERR=$$UPALL^RMPRPIX3(.RMPR60,.RMPR63,.RMPR11I) 110 .I '$G(RMPR63("IEN")) S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11I) 111 I '$G(RMPR6("IEN")) D 112 .S RMPRERR=$$CRE^RMPRPIX6(.RMPR60,.RMPR11I) 113 .S (RMPR60("IEN6"),RMPR6("IEN"))=$G(RMPR60("IEN")) 114 .S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11I) 115 ;create a return stock record 116 S RMPR11I("HCPCS")=$G(RMPRRET("HCPCS")) 117 S RMPR11I("ITEM")=$G(RMPRRET("ITEM")) 118 S RMPRRET("SEQUENCE")=1 119 S RMPRRET("TRAN TYPE")=8 120 S RMPRRET("COMMENT")="STOCK ISSUE EDIT" 121 S RMPRRET("USER")=$G(DUZ) 122 I '$D(RMPRRET("QUANTITY")) S RMPRRET("QUANTITY")=RMPR60("QUANTITY") 123 I '$D(RMPRRET("VALUE")) S RMPRRET("VALUE")=RMPR60("COST") 124 I '$D(RMPRRET("UNIT")) S RMPRRET("UNIT")=RMPR60("UNIT") 125 I '$D(RMPRRET("VENDOR")) S RMPRRET("VENDOR")=RMPR60("VENDOR IEN") 126 I '$D(RMPRRET("LOCATION")) S RMPRRET("LOCATION")=$G(RMLO1) 127 I $D(RMPR11I) D I $G(RMPRERR) Q 128 .S RMPRERR=$$CRE^RMPRPIX6(.RMPRRET,.RMPR11I) 129 ;return/update 661.7 130 D BACK Q:$G(RMPRERR) 131 S RMPR11I("HCPCS")=$G(RMNEWHC) 132 S RMPR11I("ITEM")=$G(RMNEWIT) 133 S RMPR7I("QUANTITY")=RMPR60("QUANTITY") 134 S RMPR7I("VALUE")=RMPR60("COST") 135 ;update or create 661.7 entry 136 D UP7 137 S RMPR9("QUANTITY")=RMPR60("QUANTITY") 138 S RMPR9("VALUE")=RMPR60("COST") 139 ;return 661.9 entry 140 I $D(RMDTTIM) D D UP9 141 .S RMPR11I("HCPCS")=RMPRRET("HCPCS") 142 .S RMPR11I("ITEM")=RMPRRET("ITEM") 143 .S RMPR9("QUANTITY")=$P(R1BCK(0),U,7) 144 .S RMPR9("VALUE")=$P(R1BCK(0),U,16) 145 ;deduct the new HCPCS in 661.9 146 S RMPR11I("HCPCS")=RMNEWHC 147 S RMPR11I("ITEM")=RMPR60("ITEM") 148 S RMPR9("QUANTITY")=0-RMPR60("QUANTITY") 149 S RMPR9("VALUE")=0-RMPR60("COST") 150 D UP9 151 Q 152 ; 153 BACK ; Bring back ITEM into current stock. 154 D NOW^%DTC 155 S (RMPR7R("STATION"),RMST1)=RMPR11I("STATION") 156 S (RMPR7R("HCPCS"),RMHC1)=RMPR11I("HCPCS") 157 S (RMPR7R("ITEM"),RMIT1)=RMPR11I("ITEM") 158 S (RMPR7R("LOCATION"),RMLO1)=RMPRRET("LOCATION") 159 S RMPR7R("VENDOR")=RMPRRET("VENDOR") 160 S RMPR7R("DATE&TIME")=% S:$G(RMPRRET("DATE&TIME"))'="" RMPR7R("DATE&TIME")=RMPRRET("DATE&TIME") 161 S RMPR7R("SEQUENCE")=1 162 S RMPR7R("QUANTITY")=RMPRRET("QUANTITY") 163 S RMPR7R("VALUE")=RMPRRET("VALUE") 164 S RMPR7R("UNIT")=$G(RMPRRET("UNIT")) 165 I $G(RMDTTIM),$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=71 Q 166 .S RMPR7R("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM,1,0)) 167 .I '$G(RMPR7R("IEN")) S RMPRERR=1 Q 168 .S RMDA7=$G(^RMPR(661.7,RMPR7R("IEN"),0)) 169 .S RMDAVAL=$P(RMDA7,U,8),RMDAQUA=$P(RMDA7,U,7) 170 .S RMPR7R("QUANTITY")=RMPR7R("QUANTITY")+RMDAQUA 171 .S RMPR7R("VALUE")=RMPR7R("VALUE")+RMDAVAL 172 .S RMPR7R("DATE&TIME")=RMDTTIM 173 .S RMPRERR=$$UPD^RMPRPIX7(.RMPR7R,.RMPR11I) 174 I $G(RMDTTIM),'$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D 175 .S RMPR7R("DATE&TIME")=RMDTTIM 176 .S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPR11I) 177 I '$G(RMDTTIM) S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPR11I) 178 Q 179 ; 180 UP6 ;now update file 661.6 181 S RMPR6("IEN")=$G(RMIEN6) 182 S RMPR6("QUANTITY")=$G(RMPR60("QUANTITY")) 183 S RMPR6("VALUE")=$G(RMPR60("COST")) 184 S RMPRERR=$$UPD^RMPRPIX6(.RMPR6,.RMPR11I) 185 Q 186 ; 187 ; 188 UP63 ;update file 661.63 189 S RMPR6("IEN")=$G(RMIEN6) 190 S RMPR6("LOCATION")=$G(RMPR5("IEN")) 191 S RMPR6("VENDOR")=$G(RMPR60("VENDOR IEN")) 192 S RMPR63("IEN")=$G(RMIEN63) 193 S RMPRERR=$$UPD^RMPRPIX3(.RMPR60,.RMPR63,.RMPR11I) 194 Q 195 ; 196 UP7 ;file #661.7,deduct quantity 197 Q:'$G(RMPR11I("STATION")) 198 S RMPR7I("STATION IEN")=RMPR11I("STATION") 199 S RMPR7I("LOCATION IEN")=$G(RMPR5("IEN")) 200 S RMPR7I("HCPCS")=RMPR11I("HCPCS") 201 S RMPR7I("ITEM")=RMPR11I("ITEM") 202 S:$G(RMPRRET("DATE&TIME")) RMPR7I("DATE&TIME")=RMPRRET("DATE&TIME") 203 S RMPR7I("ISSUED QTY")=$G(RMPR7I("QUANTITY")) 204 S RMPR7I("ISSUED VALUE")=$G(RMPR7I("VALUE")) 205 S RMPRERR=$$FIFO^RMPRPIUB(.RMPR7I) 206 Q 207 UP9 ;file 661.9 208 D NOW^%DTC 209 S RMPR9("STA")=RMPR11I("STATION") 210 S RMPR9("HCP")=RMPR11I("HCPCS") 211 S RMPR9("ITE")=RMPR11I("ITEM") 212 S RMPR9("RDT")=$P(%,".",1) 213 S RMPR9("TQTY")=RMPR9("QUANTITY") 214 S RMPR9("TCST")=RMPR9("VALUE") 215 S RMPERR=$$UPCR^RMPRPIXJ(.RMPR9) 216 Q 217 ; 218 QUAN ;only update quantity 219 ;quit if not in PIP 220 Q:'$G(RMIEN6)!'$D(RMDTTIM)!'$D(RMPRRET) 221 S RMPR11I("STATION")=RMPRRET("STATION") 222 S RMPR11I("HCPCS")=RMPRRET("HCPCS") 223 S RMPR11I("ITEM")=RMPRRET("ITEM") 224 S RMPR5("IEN")=RMPRRET("LOCATION") 225 D UP6,UP63 226 I RMPR60("QUANTITY")>($P(R1BCK(0),U,7)) D D UP7,UP9 227 .S RMPR7I("QUANTITY")=RMPR60("QUANTITY")-($P(R1BCK(0),U,7)) 228 .S RMPR7I("VALUE")=RMPR60("COST")-($P(R1BCK(0),U,16)) 229 .S RMPR9("QUANTITY")=0-($G(RMPR60("QUANTITY"))-$P(R1BCK(0),U,7)) 230 .S RMPR9("VALUE")=0-($G(RMPR60("COST"))-$P(R1BCK(0),U,16)) 231 I RMPR60("QUANTITY")<($P(R1BCK(0),U,7)) D D BACK,UP9 232 .S RMPR9("QUANTITY")=$P(R1BCK(0),U,7)-$G(RMPR60("QUANTITY")) 233 .S RMPRRET("QUANTITY")=$P(R1BCK(0),U,7)-$G(RMPR60("QUANTITY")) 234 .S RMPR9("VALUE")=$P(R1BCK(0),U,16)-$G(RMPR60("COST")) 235 .S RMPRRET("VALUE")=$P(R1BCK(0),U,16)-$G(RMPR60("COST")) 236 Q 237 ; 238 ERR W !!,"Error encountered while posting to PIP. Patient 10-2319 not deleted!! Please check with your Application Coordinator." H 5 G EXIT
Note:
See TracChangeset
for help on using the changeset viewer.
