RMPR4M ;PHX/HNB,RVD - PURCHASE CARD MODULE FUNCTIONS ;3/1/1996
;;3.0;PROSTHETICS;**3,26,28,30,41,62,90,133,189,194**;Feb 09, 1996;Build 5
;Per VA Directive 6402, this routine should not be modified.
;
; RVD patch #62 - pce and suspense link to 2319
POST2 ;*** Posting Data to 2319 *******************************************
;set global to local table/variables
S R190=$G(^RMPR(664,RMPRA,0))
S R192=$G(^RMPR(664,RMPRA,2))
S R193=$G(^RMPR(664,RMPRA,3))
S R194=$G(^RMPR(664,RMPRA,4))
W !,"...now posting to file 660..."
ADD ;for adding new entry in 2319
S RMPHC="" I $D(^TMP("RM",$J,"N")) D
.F I=0:0 S I=$O(^TMP("RM",$J,"N",I)) Q:I'>0 S RMI=$G(^RMPR(664,RMPRA,1,I,0)) I RMI D
..S RMCPT=$P($G(^RMPR(664,RMPRA,1,I,4)),U,2)
..S DIC="^RMPR(660,",DIC(0)="L",X=DT
..K DD,DO D FILE^DICN
..S $P(^RMPR(664,RMPRA,1,I,0),U,13)=+Y
..D TOT
..S:$P(RMI,U,16) RMPHC=$P(^RMPR(661.1,$P(RMI,U,16),0),U,4)
..S R19A=+Y
..S R19I=$G(^RMPR(664,RMPRA,1,I,0))
..S R19(660,R19A_",",8)=RMPR("STA")
..S R19(660,R19A_",",.02)=$P(R190,U,2)
..S R19(660,R19A_",",7)=$P(R190,U,4)
..S R19(660,R19A_",",4.3)=$P(R194,U,2)
..S R19(660,R19A_",",23)=$P(R194,U,5)
..S R19(660,R19A_",",1)=$P(R190,U,1)
..S R19(660,R19A_",",25)=$P(R193,U,1)
..S R19(660,R19A_",",27)=DUZ
..S R19(660,R19A_",",2)=$P(R19I,U,9)
..S R19(660,R19A_",",4)=$P(R19I,U,1)
..S R19(660,R19A_",",5)=$P(R19I,U,4)
..S R19(660,R19A_",",4.5)=$P(R19I,U,16)
..S R19(660,R19A_",",4.7)=RMCPT
..S R19(660,R19A_",",4.1)=RMPHC
..S R19(660,R19A_",",12)=$P(R19I,U,12)
..S R19(660,R19A_",",78)=$P(R19I,U,5)
..S R19(660,R19A_",",16)=$P(R19I,U,8)
..S R19(660,R19A_",",24)=$P(R19I,U,2)
..S R19(660,R19A_",",62)=$P(R19I,U,10)
..S R19(660,R19A_",",63)=$P(R19I,U,11)
..S R19(660,R19A_",",24)=$P(R19I,U,2)
..S R19(660,R19A_",",14)=RMTOT
..S R19(660,R19A_",",9)=$P(R19I,U,15)
..S R19(660,R19A_",",11)=14
..S R19(660,R19A_",",68)=RGRP1
..S R19(660,R19A_",",8.14)=0
..; update CONTRACT #, LOT #, and MODEL in 660
..S R19(660,R19A_",",9.2)=$$GET1^DIQ(664.02,$$I66402(R19A,RMPRA)_","_RMPRA_",",15.4)
..S R19(660,R19A_",",21)=$$GET1^DIQ(664.02,$$I66402(R19A,RMPRA)_","_RMPRA_",",15.6)
..S R19(660,R19A_",",38.7)=$P(RMI,U,14)
..D FILE^DIE("K","R19","ERROR")
..I $D(^RMPR(664,RMPRA,1,I,4)) S $P(^RMPR(660,R19A,4),U,1)=$P(^RMPR(664,RMPRA,1,I,4),U,1)
..MERGE ^RMPR(660,R19A,"DES")=^RMPR(664,RMPRA,1,I,1)
..S RMPRDFN=$P(R190,U,2)
..S RM60LINK(R19A)=""
..D CHK
;
EDIT ;for editing entry in 2319
S RMPHC="" I $D(^TMP("RM",$J,"E")) D
.F I=0:0 S I=$O(^TMP("RM",$J,"E",I)) Q:I'>0 S RMI=$G(^RMPR(664,RMPRA,1,I,0)),DA=$P(RMI,U,13) I DA D
..S RMCPT=$P($G(^RMPR(664,RMPRA,1,I,4)),U,2)
..D TOT
..S:$P(RMI,U,16) RMPHC=$P(^RMPR(661.1,$P(RMI,U,16),0),U,4)
..S $P(^RMPR(660,DA,0),U,11)=$P(RMI,U,15)
..S $P(^RMPR(660,DA,0),U,4)=$P(RMI,U,9)
..S $P(^RMPR(660,DA,0),U,7)=$P(RMI,U,4)
..S $P(^RMPR(660,DA,0),U,8)=$P(RMI,U,5)
..S $P(^RMPR(660,DA,0),U,13)=14
..S $P(^RMPR(660,DA,0),U,16)=RMTOT
..S $P(^RMPR(660,DA,"AM"),U,3)=$P(RMI,U,10)
..S $P(^RMPR(660,DA,"AM"),U,4)=$P(RMI,U,11)
..S $P(^RMPR(660,DA,0),U,22)=RMPHC
..S $P(^RMPR(660,DA,1),U,4)=$P(RMI,U,16)
..S $P(^RMPR(660,DA,1),U,6)=RMCPT
..S $P(^RMPR(660,DA,0),U,18)=$P(RMI,U,8)
..; update CONTRACT #, LOT #, and MODEL in 660
..S $P(^RMPR(660,DA,2),U,9)=$P(RMI,U,14)
..S $P(^RMPR(660,DA,0),U,24)=$$GET1^DIQ(664.02,$$I66402(DA,RMPRA)_","_RMPRA_",",15.6)
..S $P(^RMPR(660,DA,9),U,2)=$$GET1^DIQ(664.02,$$I66402(DA,RMPRA)_","_RMPRA_",",15.4)
..;update brief description field 24 in 660
..S $P(^RMPR(660,DA,1),U,2)=$P(RMI,U,2)
..I $D(^RMPR(664,RMPRA,1,I,4)) S $P(^RMPR(660,DA,4),U,1)=$P(^RMPR(664,RMPRA,1,I,4),U,1)
..;added by patch #62
..I $D(^RMPR(660,DA,10)) S RM10STAT=$P(^RMPR(660,DA,10),U,14)
..I '$D(^RMPR(660,DA,10))!'$G(RM10STAT) D
...K RM10STAT
...S RM60LINK(DA)=""
..MERGE ^RMPR(660,DA,"DES")=^RMPR(664,RMPRA,1,I,1)
..S DIK="^RMPR(660," D IX1^DIK
SHIP ;for shipping entry in 2319
I $G(RMSHIF) S DA=$P(R190,U,12) S:$G(DA) $P(^RMPR(660,DA,0),U,17)=$P(R190,U,11),$P(^RMPR(660,DA,0),U,16)=$P(R190,U,11) I '$G(DA) D
.S DIC="^RMPR(660,",DIC(0)="L",X=DT
.K DD,DO D FILE^DICN
.S $P(^RMPR(664,RMPRA,0),U,12)=+Y
.S R19IEN=$O(^RMPR(664,RMPRA,1,0)) Q:R19IEN=""
.S R19I=$G(^RMPR(664,RMPRA,1,R19IEN,0))
.S R19A=+Y
.S R19(660,R19A_",",8)=RMPR("STA")
.S R19(660,R19A_",",.02)=$P(R190,U,2)
.S R19(660,R19A_",",7)=$P(R190,U,4)
.S R19(660,R19A_",",4.3)=$P(R194,U,2)
.S R19(660,R19A_",",23)=$P(R194,U,5)
.S R19(660,R19A_",",1)=$P(R190,U,1)
.S R19(660,R19A_",",2)="X"
.S R19(660,R19A_",",25)=$P(R193,U,1)
.S R19(660,R19A_",",27)=DUZ
.S R19(660,R19A_",",6)=$P(R190,U,11)
.S R19(660,R19A_",",14)=$P(R190,U,11)
.S R19(660,R19A_",",11)=14
.S R19(660,R19A_",",12)="C"
.S R19(660,R19A_",",62)=$P(R19I,U,10)
.S R19(660,R19A_",",63)=$P(R19I,U,11)
.S R19(660,R19A_",",68)=RGRP1
.D FILE^DIE("K","R19","ERROR")
.I $D(^RMPR(660,R19A,10)) S RM10STAT=$P(^RMPR(660,R19A,10),U,14)
.I '$D(^RMPR(660,R19A,10))!'$G(RM10STAT) D
..K RM10STAT
..S RM60LINK(R19A)=""
;
CAN ;for CANCELING entry in 2319
;call pce delete if patient encounter was recorded.
N RMI
I $D(^TMP("RM",$J,"C")) S DIK="^RMPR(660," F RMI=0:0 S RMI=$O(^TMP("RM",$J,"C",RMI)) Q:RMI'>0 D
.I $D(^RMPR(660,RMI,10)),$P(^RMPR(660,RMI,10),U,12) D
..S RMCHK=0
..S RMCHK=$$DEL^RMPRPCED(RMI)
.S DA=RMI D ^DIK
;
UPD ; Update Percent discount, Bank Authorization and remove shipping entry.
I $G(RMPERF)!$G(RMBANF) D
.F I=0:0 S I=$O(^RMPR(664,RMPRA,1,I)) Q:I'>0 S RMI=$G(^(I,0)),DA=$P(RMI,U,13) I DA D
..I $G(RMPERF) D TOT S $P(^RMPR(660,DA,0),U,16)=RMTOT
..S:$G(RMBANF) $P(^RMPR(660,DA,4),U,2)=$P(R194,U,2)
I $G(RMSHIF),($P(^RMPR(664,RMPRA,0),U,11)=0) S DA=$P(^(0),U,12),DIK="^RMPR(660," D ^DIK S $P(^RMPR(664,RMPRA,0),U,12)=""
;
KILL K RMTOT,RMI,R19I,R19A,DR,DA,RMPERF,RMBANF,RMSHIF,RMPHC,RMCPT
Q
TOT S RMACT=$P(RMI,U,7),RMUNC=$P(RMI,U,3),RMQTY=$P(RMI,U,4)
I DCT S RMTOT=$S(RMACT=0!(RMACT>0):RMACT-$J(RMACT*DCT,0,2)*RMQTY,1:RMUNC-$J(RMUNC*DCT,0,2)*RMQTY)
I 'DCT S RMTOT=$S(RMACT=0!(RMACT>0):RMACT*RMQTY,1:RMUNC*RMQTY)
Q
CHK I '$D(^RMPR(660,R19A,0)) W !!,$C(7),"**** POSTING TO 2319 FOR ITEM.."_I_" FAILED",!,"PLEASE RUN CLOSE-OUT OPTION AGAIN..." G KTMP^RMPR4E21
Q
I66402(RMI660,RMI664) ; obtain IEN of line in 664.02 that contains match for pointer to 660
; RMI660 - IEN in 660 which is the one that we are checking 664.02 for
; RMI664 - IEN in 664 that we are searching on
N RMNS
S RMNS=0
F S RMNS=$O(^RMPR(664,RMI664,1,RMNS)) Q:+RMNS=0 Q:$P(^RMPR(664,RMI664,1,RMNS,0),U,13)=RMI660
Q RMNS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR4M 6636 printed Dec 13, 2024@02:32:51 Page 2
RMPR4M ;PHX/HNB,RVD - PURCHASE CARD MODULE FUNCTIONS ;3/1/1996
+1 ;;3.0;PROSTHETICS;**3,26,28,30,41,62,90,133,189,194**;Feb 09, 1996;Build 5
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; RVD patch #62 - pce and suspense link to 2319
POST2 ;*** Posting Data to 2319 *******************************************
+1 ;set global to local table/variables
+2 SET R190=$GET(^RMPR(664,RMPRA,0))
+3 SET R192=$GET(^RMPR(664,RMPRA,2))
+4 SET R193=$GET(^RMPR(664,RMPRA,3))
+5 SET R194=$GET(^RMPR(664,RMPRA,4))
+6 WRITE !,"...now posting to file 660..."
ADD ;for adding new entry in 2319
+1 SET RMPHC=""
IF $DATA(^TMP("RM",$JOB,"N"))
Begin DoDot:1
+2 FOR I=0:0
SET I=$ORDER(^TMP("RM",$JOB,"N",I))
if I'>0
QUIT
SET RMI=$GET(^RMPR(664,RMPRA,1,I,0))
IF RMI
Begin DoDot:2
+3 SET RMCPT=$PIECE($GET(^RMPR(664,RMPRA,1,I,4)),U,2)
+4 SET DIC="^RMPR(660,"
SET DIC(0)="L"
SET X=DT
+5 KILL DD,DO
DO FILE^DICN
+6 SET $PIECE(^RMPR(664,RMPRA,1,I,0),U,13)=+Y
+7 DO TOT
+8 if $PIECE(RMI,U,16)
SET RMPHC=$PIECE(^RMPR(661.1,$PIECE(RMI,U,16),0),U,4)
+9 SET R19A=+Y
+10 SET R19I=$GET(^RMPR(664,RMPRA,1,I,0))
+11 SET R19(660,R19A_",",8)=RMPR("STA")
+12 SET R19(660,R19A_",",.02)=$PIECE(R190,U,2)
+13 SET R19(660,R19A_",",7)=$PIECE(R190,U,4)
+14 SET R19(660,R19A_",",4.3)=$PIECE(R194,U,2)
+15 SET R19(660,R19A_",",23)=$PIECE(R194,U,5)
+16 SET R19(660,R19A_",",1)=$PIECE(R190,U,1)
+17 SET R19(660,R19A_",",25)=$PIECE(R193,U,1)
+18 SET R19(660,R19A_",",27)=DUZ
+19 SET R19(660,R19A_",",2)=$PIECE(R19I,U,9)
+20 SET R19(660,R19A_",",4)=$PIECE(R19I,U,1)
+21 SET R19(660,R19A_",",5)=$PIECE(R19I,U,4)
+22 SET R19(660,R19A_",",4.5)=$PIECE(R19I,U,16)
+23 SET R19(660,R19A_",",4.7)=RMCPT
+24 SET R19(660,R19A_",",4.1)=RMPHC
+25 SET R19(660,R19A_",",12)=$PIECE(R19I,U,12)
+26 SET R19(660,R19A_",",78)=$PIECE(R19I,U,5)
+27 SET R19(660,R19A_",",16)=$PIECE(R19I,U,8)
+28 SET R19(660,R19A_",",24)=$PIECE(R19I,U,2)
+29 SET R19(660,R19A_",",62)=$PIECE(R19I,U,10)
+30 SET R19(660,R19A_",",63)=$PIECE(R19I,U,11)
+31 SET R19(660,R19A_",",24)=$PIECE(R19I,U,2)
+32 SET R19(660,R19A_",",14)=RMTOT
+33 SET R19(660,R19A_",",9)=$PIECE(R19I,U,15)
+34 SET R19(660,R19A_",",11)=14
+35 SET R19(660,R19A_",",68)=RGRP1
+36 SET R19(660,R19A_",",8.14)=0
+37 ; update CONTRACT #, LOT #, and MODEL in 660
+38 SET R19(660,R19A_",",9.2)=$$GET1^DIQ(664.02,$$I66402(R19A,RMPRA)_","_RMPRA_",",15.4)
+39 SET R19(660,R19A_",",21)=$$GET1^DIQ(664.02,$$I66402(R19A,RMPRA)_","_RMPRA_",",15.6)
+40 SET R19(660,R19A_",",38.7)=$PIECE(RMI,U,14)
+41 DO FILE^DIE("K","R19","ERROR")
+42 IF $DATA(^RMPR(664,RMPRA,1,I,4))
SET $PIECE(^RMPR(660,R19A,4),U,1)=$PIECE(^RMPR(664,RMPRA,1,I,4),U,1)
+43 MERGE ^RMPR(660,R19A,"DES")=^RMPR(664,RMPRA,1,I,1)
+44 SET RMPRDFN=$PIECE(R190,U,2)
+45 SET RM60LINK(R19A)=""
+46 DO CHK
End DoDot:2
End DoDot:1
+47 ;
EDIT ;for editing entry in 2319
+1 SET RMPHC=""
IF $DATA(^TMP("RM",$JOB,"E"))
Begin DoDot:1
+2 FOR I=0:0
SET I=$ORDER(^TMP("RM",$JOB,"E",I))
if I'>0
QUIT
SET RMI=$GET(^RMPR(664,RMPRA,1,I,0))
SET DA=$PIECE(RMI,U,13)
IF DA
Begin DoDot:2
+3 SET RMCPT=$PIECE($GET(^RMPR(664,RMPRA,1,I,4)),U,2)
+4 DO TOT
+5 if $PIECE(RMI,U,16)
SET RMPHC=$PIECE(^RMPR(661.1,$PIECE(RMI,U,16),0),U,4)
+6 SET $PIECE(^RMPR(660,DA,0),U,11)=$PIECE(RMI,U,15)
+7 SET $PIECE(^RMPR(660,DA,0),U,4)=$PIECE(RMI,U,9)
+8 SET $PIECE(^RMPR(660,DA,0),U,7)=$PIECE(RMI,U,4)
+9 SET $PIECE(^RMPR(660,DA,0),U,8)=$PIECE(RMI,U,5)
+10 SET $PIECE(^RMPR(660,DA,0),U,13)=14
+11 SET $PIECE(^RMPR(660,DA,0),U,16)=RMTOT
+12 SET $PIECE(^RMPR(660,DA,"AM"),U,3)=$PIECE(RMI,U,10)
+13 SET $PIECE(^RMPR(660,DA,"AM"),U,4)=$PIECE(RMI,U,11)
+14 SET $PIECE(^RMPR(660,DA,0),U,22)=RMPHC
+15 SET $PIECE(^RMPR(660,DA,1),U,4)=$PIECE(RMI,U,16)
+16 SET $PIECE(^RMPR(660,DA,1),U,6)=RMCPT
+17 SET $PIECE(^RMPR(660,DA,0),U,18)=$PIECE(RMI,U,8)
+18 ; update CONTRACT #, LOT #, and MODEL in 660
+19 SET $PIECE(^RMPR(660,DA,2),U,9)=$PIECE(RMI,U,14)
+20 SET $PIECE(^RMPR(660,DA,0),U,24)=$$GET1^DIQ(664.02,$$I66402(DA,RMPRA)_","_RMPRA_",",15.6)
+21 SET $PIECE(^RMPR(660,DA,9),U,2)=$$GET1^DIQ(664.02,$$I66402(DA,RMPRA)_","_RMPRA_",",15.4)
+22 ;update brief description field 24 in 660
+23 SET $PIECE(^RMPR(660,DA,1),U,2)=$PIECE(RMI,U,2)
+24 IF $DATA(^RMPR(664,RMPRA,1,I,4))
SET $PIECE(^RMPR(660,DA,4),U,1)=$PIECE(^RMPR(664,RMPRA,1,I,4),U,1)
+25 ;added by patch #62
+26 IF $DATA(^RMPR(660,DA,10))
SET RM10STAT=$PIECE(^RMPR(660,DA,10),U,14)
+27 IF '$DATA(^RMPR(660,DA,10))!'$GET(RM10STAT)
Begin DoDot:3
+28 KILL RM10STAT
+29 SET RM60LINK(DA)=""
End DoDot:3
+30 MERGE ^RMPR(660,DA,"DES")=^RMPR(664,RMPRA,1,I,1)
+31 SET DIK="^RMPR(660,"
DO IX1^DIK
End DoDot:2
End DoDot:1
SHIP ;for shipping entry in 2319
+1 IF $GET(RMSHIF)
SET DA=$PIECE(R190,U,12)
if $GET(DA)
SET $PIECE(^RMPR(660,DA,0),U,17)=$PIECE(R190,U,11)
SET $PIECE(^RMPR(660,DA,0),U,16)=$PIECE(R190,U,11)
IF '$GET(DA)
Begin DoDot:1
+2 SET DIC="^RMPR(660,"
SET DIC(0)="L"
SET X=DT
+3 KILL DD,DO
DO FILE^DICN
+4 SET $PIECE(^RMPR(664,RMPRA,0),U,12)=+Y
+5 SET R19IEN=$ORDER(^RMPR(664,RMPRA,1,0))
if R19IEN=""
QUIT
+6 SET R19I=$GET(^RMPR(664,RMPRA,1,R19IEN,0))
+7 SET R19A=+Y
+8 SET R19(660,R19A_",",8)=RMPR("STA")
+9 SET R19(660,R19A_",",.02)=$PIECE(R190,U,2)
+10 SET R19(660,R19A_",",7)=$PIECE(R190,U,4)
+11 SET R19(660,R19A_",",4.3)=$PIECE(R194,U,2)
+12 SET R19(660,R19A_",",23)=$PIECE(R194,U,5)
+13 SET R19(660,R19A_",",1)=$PIECE(R190,U,1)
+14 SET R19(660,R19A_",",2)="X"
+15 SET R19(660,R19A_",",25)=$PIECE(R193,U,1)
+16 SET R19(660,R19A_",",27)=DUZ
+17 SET R19(660,R19A_",",6)=$PIECE(R190,U,11)
+18 SET R19(660,R19A_",",14)=$PIECE(R190,U,11)
+19 SET R19(660,R19A_",",11)=14
+20 SET R19(660,R19A_",",12)="C"
+21 SET R19(660,R19A_",",62)=$PIECE(R19I,U,10)
+22 SET R19(660,R19A_",",63)=$PIECE(R19I,U,11)
+23 SET R19(660,R19A_",",68)=RGRP1
+24 DO FILE^DIE("K","R19","ERROR")
+25 IF $DATA(^RMPR(660,R19A,10))
SET RM10STAT=$PIECE(^RMPR(660,R19A,10),U,14)
+26 IF '$DATA(^RMPR(660,R19A,10))!'$GET(RM10STAT)
Begin DoDot:2
+27 KILL RM10STAT
+28 SET RM60LINK(R19A)=""
End DoDot:2
End DoDot:1
+29 ;
CAN ;for CANCELING entry in 2319
+1 ;call pce delete if patient encounter was recorded.
+2 NEW RMI
+3 IF $DATA(^TMP("RM",$JOB,"C"))
SET DIK="^RMPR(660,"
FOR RMI=0:0
SET RMI=$ORDER(^TMP("RM",$JOB,"C",RMI))
if RMI'>0
QUIT
Begin DoDot:1
+4 IF $DATA(^RMPR(660,RMI,10))
IF $PIECE(^RMPR(660,RMI,10),U,12)
Begin DoDot:2
+5 SET RMCHK=0
+6 SET RMCHK=$$DEL^RMPRPCED(RMI)
End DoDot:2
+7 SET DA=RMI
DO ^DIK
End DoDot:1
+8 ;
UPD ; Update Percent discount, Bank Authorization and remove shipping entry.
+1 IF $GET(RMPERF)!$GET(RMBANF)
Begin DoDot:1
+2 FOR I=0:0
SET I=$ORDER(^RMPR(664,RMPRA,1,I))
if I'>0
QUIT
SET RMI=$GET(^(I,0))
SET DA=$PIECE(RMI,U,13)
IF DA
Begin DoDot:2
+3 IF $GET(RMPERF)
DO TOT
SET $PIECE(^RMPR(660,DA,0),U,16)=RMTOT
+4 if $GET(RMBANF)
SET $PIECE(^RMPR(660,DA,4),U,2)=$PIECE(R194,U,2)
End DoDot:2
End DoDot:1
+5 IF $GET(RMSHIF)
IF ($PIECE(^RMPR(664,RMPRA,0),U,11)=0)
SET DA=$PIECE(^(0),U,12)
SET DIK="^RMPR(660,"
DO ^DIK
SET $PIECE(^RMPR(664,RMPRA,0),U,12)=""
+6 ;
KILL KILL RMTOT,RMI,R19I,R19A,DR,DA,RMPERF,RMBANF,RMSHIF,RMPHC,RMCPT
+1 QUIT
TOT SET RMACT=$PIECE(RMI,U,7)
SET RMUNC=$PIECE(RMI,U,3)
SET RMQTY=$PIECE(RMI,U,4)
+1 IF DCT
SET RMTOT=$SELECT(RMACT=0!(RMACT>0):RMACT-$JUSTIFY(RMACT*DCT,0,2)*RMQTY,1:RMUNC-$JUSTIFY(RMUNC*DCT,0,2)*RMQTY)
+2 IF 'DCT
SET RMTOT=$SELECT(RMACT=0!(RMACT>0):RMACT*RMQTY,1:RMUNC*RMQTY)
+3 QUIT
CHK IF '$DATA(^RMPR(660,R19A,0))
WRITE !!,$CHAR(7),"**** POSTING TO 2319 FOR ITEM.."_I_" FAILED",!,"PLEASE RUN CLOSE-OUT OPTION AGAIN..."
GOTO KTMP^RMPR4E21
+1 QUIT
I66402(RMI660,RMI664) ; obtain IEN of line in 664.02 that contains match for pointer to 660
+1 ; RMI660 - IEN in 660 which is the one that we are checking 664.02 for
+2 ; RMI664 - IEN in 664 that we are searching on
+3 NEW RMNS
+4 SET RMNS=0
+5 FOR
SET RMNS=$ORDER(^RMPR(664,RMI664,1,RMNS))
if +RMNS=0
QUIT
if $PIECE(^RMPR(664,RMI664,1,RMNS,0),U,13)=RMI660
QUIT
+6 QUIT RMNS
