RMPRE21 ;PHX/HNC - CLOSE OUT 1358 ;8/29/1994
;;3.0;PROSTHETICS;**12,28,30,34,41,62,78**;Feb 09, 1996
; RMS 08/25/03 Patch #78 - Add shipment date
; RVD #62 - 1/14/02 include an auto-link
;
EDIT K ^TMP($J) S PRCS("A")="Select OBLIGATION NUMBER: " D EN1^PRCS58 G:Y=-1 EXIT S RMPR("OB")=$P(Y(0),U,1),RMPROB=$P(Y,U,2) D BAL^RMPRPSC
CL K DIC S DIC="664",DIC(0)="AEQM"
S DIC("W")="D EN2^RMPRD1"
S DIC("A")="Select PATIENT: "
S DIC("S")="S RZZZ=^(0) I $P(RZZZ,U,3)=RMPROB,('$P(RZZZ,U,8)&'$P(RZZZ,U,5)),($P(RZZZ,U,14)=RMPR(""STA""))"
I RMPRSITE=1 S DIC("S")=DIC("S")_"!($P(RZZZ,U,14)="""")"
D ^DIC S (DA,RMPRA)=+Y I Y=-1 K:(X["^")!(X="^") RMPROB G EXIT
K DIC G:$P(^RMPR(664,RMPRA,0),U,8) M4 G:$P(^(0),U,5) M6
K ^TMP($J),RHCED D GET^RMPRFSH
L +^RMPR(664,RMPRA,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
S (RMPRDFN,DFN)=$P(^RMPR(664,RMPRA,0),U,2),RMPRWO=$P(^(0),U,15),RMPRDA=$P(^(0),U,17),RMPRNAM=$P(^DPT(DFN,0),U,1),RMPRSSN=$P(^(0),U,9) K RZZZ
;added by #62
;get amis grouper number RGRP1
S RGRP1=""
S RGRP=$O(^RMPR(664,RMPRA,1,0)) G:'RGRP L S RGRPP=$P($G(^RMPR(664,RMPRA,1,RGRP,0)),U,13) I 'RGRPP G L
S RGRP1=$P($G(^RMPR(660,RGRPP,"AMS")),U,1)
;
;set shipping entry and collect previous linkage.
I $P(^RMPR(664,RMPRA,0),U,12) S RMSHIEN=$P(^RMPR(664,RMPRA,0),U,12) S:'$D(^RMPR(660,RMSHIEN,10)) RM60LINK(RMSHIEN)=""
D COL^RMPRPCEL
;
L D ^RMPRLI
ASK ;ASKS THE USER IF THEY WANT TO CLOSE-OUT THE TRANSACTION
S:'$D(RMPRSER) RMPRSER="" K DCT S %=2
W !!!,"Ready to Close-Out Transaction"
D YN^DICN G:$D(DTOUT) EX G:%=2&(RMPRF=10) EX G:%=1 POST2^RMPRM
I %=0 W !!,"You may now Close-out and Post this Transaction. Please answer Yes or No." G ASK
I %=-1 W !,"Transaction NOT Closed-Out!" S $P(^RMPR(664,RMPRA,0),U,11)="" K RMPROB G EXIT
I '$D(^RMPR(664,RMPRA,1)) S DA=RMPRA,DIE="^RMPR(664,",DR="12" D ^DIE G L
L1 G:'$D(^RMPR(664,RMPRA,1)) L
W !,"Enter Item to Edit: " R X:DTIME G:'$T EXIT
G:X["^"!(X="") DS I X["?" D ZDSP^RMPR21A G L1
S DIC="^RMPR(664,"_RMPRA_",1,",DIC(0)="EQMZ"
D ^DIC G:Y<0 L S RMPRSD=+Y_"^"_Y(0)
S DA=+Y,DA(1)=RMPRA,DIE=DIC,RHCOLD=$P($G(^RMPR(664,RMPRA,1,DA,0)),U,16)
S RD660=$P($G(^RMPR(664,RMPRA,1,DA,0)),U,13)
;S DR=".01;1;15;6;3;16;8;9;I $P(^RMPR(664,DA(1),1,DA,0),U,10)'=4 S Y="""";10"
S DR="8;9;S RMTYPE=$P(^RMPR(664,DA(1),1,DA,0),U,9);I $P(^RMPR(664,DA(1),1,DA,0),U,10)=4 S Y=10;.01;16;1;15;6;3;S Y="""";10;.01;16;1;15;6;3"
D ^DIE
I '$D(DA) S DIK="^RMPR(660,",DA=RD660,RHCED=1 D ^DIK K RAC,DA,DIK,RMTYPE G CHK
;check for Type of Transaction and update the cpt modifier.
D CHKCPT^RMPR21A
;force HCPCS & CPT MODIFIER in 660 even transaction is not closed.
S RD660=$P(^RMPR(664,RMPRA,1,DA,0),U,13),RHCNEW=$P(^(0),U,16)
S $P(^RMPR(660,RD660,1),U,6)=$P($G(^RMPR(664,RMPRA,1,DA,4)),U,2)
I RHCOLD'=RHCNEW S RHCED=1,DA=RD660,DIE="^RMPR(660,",DR="4.5///^S X=$G(RHCNEW)" D ^DIE
CHK S FL=1 I $D(^RMPR(664,RMPRA,1)) S FL=0 F RI=0:0 S RI=$O(^RMPR(664,RMPRA,1,RI)) Q:RI'>0 I $D(^(RI,0)) S FL=1
I 'FL W !!,$C(7),?5,"REQUIRED ITEMS DO NOT EXIST ON THIS FORM",!,?8,"THIS TRANSACTION HAS BEEN CANCELED",! S RMPRAR=$P(^RMPR(664,RMPRA,0),U,12),$P(^(0),U,12)="" D:RMPRAR K660^RMPRC21
I 'FL S X=$P(^RMPR(664,RMPRA,0),U,7),DIC=424,DIC(0)="MZ" D ^DIC S $P(B2,U,7)=+Y,B3=Y(0) G C58^RMPRC21
G L1
DS W !! S DA=RMPRA,DIE="^RMPR(664,",DR="12;17" D ^DIE G L
POST1 ;POSTS THE COMPLETED TRANSACTION TO 664,660 AND 424
S R1=0
F S R1=$O(^RMPR(664,RMPRA,1,R1)) Q:R1'>0 S RMPRAR=$S($P(^RMPR(664,RMPRA,1,R1,0),U,13)'="":$P(^(0),U,13),1:"NP") Q:R1'>0 G:'$D(^RMPR(660,+RMPRAR,0)) UNK D ^RMPRE22
I $D(RMPRWO),+RMPRWO D DA0^RMPR29M(RMPRDA,RMPRA)
I $P(^RMPR(664,RMPRA,0),U,10)>0&($P(^(0),U,11)=0)&($P(^(0),U,12)) S DA=$P(^(0),U,12),DIK="^RMPR(660," D ^DIK
I $P(^RMPR(664,RMPRA,0),U,12)&(RMPRSH>0) S $P(^RMPR(660,$P(^RMPR(664,RMPRA,0),U,12),0),U,16)=RMPRSH,$P(^(0),U,12)=DT D
.S DA=$P(^RMPR(664,RMPRA,0),U,12),DIK="^RMPR(660," D IX1^DIK
.I $D(RMPRWO),$D(^RMPR(664.2,+RMPRWO,0)) S $P(^RMPR(664.2,RMPRWO,0),U,7)=$P(^(0),U,7)+RMPRSH D POST^RMPR29U
; Prompt for Shipment Date, mark as billable, Patch 78, Added by RMS
D ^RMPR4E23
I RMPRSH>0&('$P(^RMPR(664,RMPRA,0),U,12))&($P(^(0),U,11)) G PSH
W !!,?5,$C(7),"Closed out Transaction"
N DA,DIK S DA=RMPRA,DIK="^RMPR(664," D IX1^DIK
G EX
PSH S RMPRB=$O(^RMPR(664,RMPRA,1,0))
S X=DT,DIC(0)="AEQLM",DLAYGO=660,DIC="^RMPR(660,"
S DIC("DR")=".02////^S X="_$P(^RMPR(664,RMPRA,0),U,2)
K DINUM,DD,DO D FILE^DICN K DLAYGO
S ^RMPR(660,+Y,0)=DT_U_RMPRDFN_U_$P(^RMPR(664,RMPRA,0),U)_"^X^^^^^"_$P(^(0),U,4)_U_RMPR("STA")_U_$P(^RMPR(664,RMPRA,1,RMPRB,0),U,15)_U_DT_U_$S($P(^RMPR(660,$P(^RMPR(664,RMPRA,1,RMPRB,0),U,13),0),U,13):$P(^(0),U,13),1:"")
S $P(^RMPR(660,+Y,0),U,14)="C"
S $P(^RMPR(660,+Y,0),U,16)=$G(RMPRSH)
S $P(^RMPR(660,+Y,0),U,17)=$G(RMPRSH)
;INITIATOR
S $P(^RMPR(660,+Y,0),U,27)=$G(DUZ)
;HCPCS code
S RMHCPC=$P(^RMPR(664,RMPRA,1,RMPRB,0),U,16)
S:RMHCPC $P(^RMPR(660,+Y,0),U,22)=$P(^RMPR(661.1,RMHCPC,0),U,4)
S $P(^RMPR(660,+Y,1),U,4)=RMHCPC
S ^RMPR(660,+Y,"AM")=U_U_$P(^RMPR(664,RMPRA,1,RMPRB,0),U,10)_U_$P(^RMPR(664,RMPRA,1,RMPRB,0),U,11)
S $P(^RMPR(660,+Y,"AMS"),U,1)=$G(RGRP1)
;
;use da in ix1^dik call
S:$D(Y) $P(^RMPR(664,RMPRA,0),U,12)=+Y
S INX=+Y
I $D(RMPRWO),$D(^RMPR(664.2,+RMPRWO,0)) N Y S $P(^("AM"),U,2)=1 S $P(^RMPR(664.2,RMPRWO,0),U,7)=$P(^RMPR(664.2,RMPRWO,0),U,7)+RMPRSH D DA0^RMPR29M(RMPRDA,RMPRA),POST^RMPR29U
S DA=INX,DIK="^RMPR(660," D IX1^DIK
S RM60LINK(INX)=""
;
W !!,?5,$C(7),"Closed out 1358 Transaction"
N DA,DIK S DA=RMPRA,DIK="^RMPR(664," D IX1^DIK
;
G EX
EX D EN1^RMPRFSH L -^RMPR(664,RMPRA,0) I RMPRF'=10,RMPRF'="E" D LINK^RMPRS
;added by #62
;call suspense listmanager screen for multiple suspense and items.
I $D(RM60LINK),RMPRF="E",RM68FG>1 D MAN^RMPRPCEL
;
;do auto-link if only one suspense
I $D(RM60LINK),RMPRF="E",RM68FG=1 D AUTO^RMPRPCEL
K INX,RM68LINK,RM668I,RM660I,RM664DAT,RM668D10,RM60LINK,RMSHIEN,RM68LIFG
;
I $D(RMPRF),RMPRF'=10 W !!,"Enter Next Transaction to Close-out, or <RETURN> to Continue."
K RMPR("AMT"),RMPRAR,RMPRSER,RMPRTO,RMPRCT,RMPRQT,RMPRSH,RZZZ,R1,B2,%,Y,DIC,R2,RMPRA,RMPRCTDA,DIE,DIK,DR,RMPR("DRN"),RMPR("DDT"),DCT,DIR,B3,RMPRB K ^TMP($J)
K RGRP,RGRP1,RGRPP
I $D(RMPRF),RMPRF=10 Q
K X G CL
;
EXIT ;KILL VARIABLES AND EXIT ROUTINE
D:$D(^TMP($J))&'$D(RHCED) EN2^RMPRFSH L:$D(RMPRA) -^RMPR(664,RMPRA,0)
K PRCSCPAN,LINE,PRCSIP,RMPRAMIS,RMPRCNT,RMPRIT,RMPRIT1,RMPRU,RMPRX,RMPR("AMT"),AMT,BO,PRCSX,PRCS("A"),RMPRA1,RMPRDFN,RMPRNAM,RMPRSSN,RMPRAR
K DCT,RMPRTO,RMPRCT,RMPRQT,RMPRSH,RZZZ,R1,B2,%,Y,DIC,R2,RMPRA,RMPRCT,RMPRI,RMPRCONT,DIR,RMX,RHCED,RHCNEW,RHCOLD
K RMPRSER,FL,RMPRN,RMPRI1,RA,DIRUT,DA,DFN,DIE,DIK,DR,RMPR("DRN"),RMPR("DDT"),RMPR("OB"),RD,RC,RIT,RIN,RZ,RT,RF,RE,RAC,RMPRSD,DCTZ,ACT,RI,RMPRP,RMPR90,RMPRAMT,RMPRPSC,^TMP($J),B2,RMPRCC,B3,J,K,DIR,PQTY,RD660
I $D(RMPROB) D PRCS^RMPRPSC G:(X'["^")!(X'="^") CL
K RMPRF,RMPROB,PRC,RMHCPC,PRCRI,RBL,RDA,RMPRDELN,RMPRWO,RVA Q
UNK W !,$C(7),"UNKNOWN 2319 RECORD TO UPDATE, IFCAP DAILY RECORD NOT UPDATED!" G EXIT
M4 W !,$C(7),"This Transaction has already been CLOSED!" G EXIT
M6 W !,$C(7),"This Transaction has been CANCELED!" G EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRE21 7212 printed Oct 16, 2024@18:34:52 Page 2
RMPRE21 ;PHX/HNC - CLOSE OUT 1358 ;8/29/1994
+1 ;;3.0;PROSTHETICS;**12,28,30,34,41,62,78**;Feb 09, 1996
+2 ; RMS 08/25/03 Patch #78 - Add shipment date
+3 ; RVD #62 - 1/14/02 include an auto-link
+4 ;
EDIT KILL ^TMP($JOB)
SET PRCS("A")="Select OBLIGATION NUMBER: "
DO EN1^PRCS58
if Y=-1
GOTO EXIT
SET RMPR("OB")=$PIECE(Y(0),U,1)
SET RMPROB=$PIECE(Y,U,2)
DO BAL^RMPRPSC
CL KILL DIC
SET DIC="664"
SET DIC(0)="AEQM"
+1 SET DIC("W")="D EN2^RMPRD1"
+2 SET DIC("A")="Select PATIENT: "
+3 SET DIC("S")="S RZZZ=^(0) I $P(RZZZ,U,3)=RMPROB,('$P(RZZZ,U,8)&'$P(RZZZ,U,5)),($P(RZZZ,U,14)=RMPR(""STA""))"
+4 IF RMPRSITE=1
SET DIC("S")=DIC("S")_"!($P(RZZZ,U,14)="""")"
+5 DO ^DIC
SET (DA,RMPRA)=+Y
IF Y=-1
if (X["^")!(X="^")
KILL RMPROB
GOTO EXIT
+6 KILL DIC
if $PIECE(^RMPR(664,RMPRA,0),U,8)
GOTO M4
if $PIECE(^(0),U,5)
GOTO M6
+7 KILL ^TMP($JOB),RHCED
DO GET^RMPRFSH
+8 LOCK +^RMPR(664,RMPRA,0):1
IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Editing this entry!"
GOTO EXIT
+9 SET (RMPRDFN,DFN)=$PIECE(^RMPR(664,RMPRA,0),U,2)
SET RMPRWO=$PIECE(^(0),U,15)
SET RMPRDA=$PIECE(^(0),U,17)
SET RMPRNAM=$PIECE(^DPT(DFN,0),U,1)
SET RMPRSSN=$PIECE(^(0),U,9)
KILL RZZZ
+10 ;added by #62
+11 ;get amis grouper number RGRP1
+12 SET RGRP1=""
+13 SET RGRP=$ORDER(^RMPR(664,RMPRA,1,0))
if 'RGRP
GOTO L
SET RGRPP=$PIECE($GET(^RMPR(664,RMPRA,1,RGRP,0)),U,13)
IF 'RGRPP
GOTO L
+14 SET RGRP1=$PIECE($GET(^RMPR(660,RGRPP,"AMS")),U,1)
+15 ;
+16 ;set shipping entry and collect previous linkage.
+17 IF $PIECE(^RMPR(664,RMPRA,0),U,12)
SET RMSHIEN=$PIECE(^RMPR(664,RMPRA,0),U,12)
if '$DATA(^RMPR(660,RMSHIEN,10))
SET RM60LINK(RMSHIEN)=""
+18 DO COL^RMPRPCEL
+19 ;
L DO ^RMPRLI
ASK ;ASKS THE USER IF THEY WANT TO CLOSE-OUT THE TRANSACTION
+1 if '$DATA(RMPRSER)
SET RMPRSER=""
KILL DCT
SET %=2
+2 WRITE !!!,"Ready to Close-Out Transaction"
+3 DO YN^DICN
if $DATA(DTOUT)
GOTO EX
if %=2&(RMPRF=10)
GOTO EX
if %=1
GOTO POST2^RMPRM
+4 IF %=0
WRITE !!,"You may now Close-out and Post this Transaction. Please answer Yes or No."
GOTO ASK
+5 IF %=-1
WRITE !,"Transaction NOT Closed-Out!"
SET $PIECE(^RMPR(664,RMPRA,0),U,11)=""
KILL RMPROB
GOTO EXIT
+6 IF '$DATA(^RMPR(664,RMPRA,1))
SET DA=RMPRA
SET DIE="^RMPR(664,"
SET DR="12"
DO ^DIE
GOTO L
L1 if '$DATA(^RMPR(664,RMPRA,1))
GOTO L
+1 WRITE !,"Enter Item to Edit: "
READ X:DTIME
if '$TEST
GOTO EXIT
+2 if X["^"!(X="")
GOTO DS
IF X["?"
DO ZDSP^RMPR21A
GOTO L1
+3 SET DIC="^RMPR(664,"_RMPRA_",1,"
SET DIC(0)="EQMZ"
+4 DO ^DIC
if Y<0
GOTO L
SET RMPRSD=+Y_"^"_Y(0)
+5 SET DA=+Y
SET DA(1)=RMPRA
SET DIE=DIC
SET RHCOLD=$PIECE($GET(^RMPR(664,RMPRA,1,DA,0)),U,16)
+6 SET RD660=$PIECE($GET(^RMPR(664,RMPRA,1,DA,0)),U,13)
+7 ;S DR=".01;1;15;6;3;16;8;9;I $P(^RMPR(664,DA(1),1,DA,0),U,10)'=4 S Y="""";10"
+8 SET DR="8;9;S RMTYPE=$P(^RMPR(664,DA(1),1,DA,0),U,9);I $P(^RMPR(664,DA(1),1,DA,0),U,10)=4 S Y=10;.01;16;1;15;6;3;S Y="""";10;.01;16;1;15;6;3"
+9 DO ^DIE
+10 IF '$DATA(DA)
SET DIK="^RMPR(660,"
SET DA=RD660
SET RHCED=1
DO ^DIK
KILL RAC,DA,DIK,RMTYPE
GOTO CHK
+11 ;check for Type of Transaction and update the cpt modifier.
+12 DO CHKCPT^RMPR21A
+13 ;force HCPCS & CPT MODIFIER in 660 even transaction is not closed.
+14 SET RD660=$PIECE(^RMPR(664,RMPRA,1,DA,0),U,13)
SET RHCNEW=$PIECE(^(0),U,16)
+15 SET $PIECE(^RMPR(660,RD660,1),U,6)=$PIECE($GET(^RMPR(664,RMPRA,1,DA,4)),U,2)
+16 IF RHCOLD'=RHCNEW
SET RHCED=1
SET DA=RD660
SET DIE="^RMPR(660,"
SET DR="4.5///^S X=$G(RHCNEW)"
DO ^DIE
CHK SET FL=1
IF $DATA(^RMPR(664,RMPRA,1))
SET FL=0
FOR RI=0:0
SET RI=$ORDER(^RMPR(664,RMPRA,1,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET FL=1
+1 IF 'FL
WRITE !!,$CHAR(7),?5,"REQUIRED ITEMS DO NOT EXIST ON THIS FORM",!,?8,"THIS TRANSACTION HAS BEEN CANCELED",!
SET RMPRAR=$PIECE(^RMPR(664,RMPRA,0),U,12)
SET $PIECE(^(0),U,12)=""
if RMPRAR
DO K660^RMPRC21
+2 IF 'FL
SET X=$PIECE(^RMPR(664,RMPRA,0),U,7)
SET DIC=424
SET DIC(0)="MZ"
DO ^DIC
SET $PIECE(B2,U,7)=+Y
SET B3=Y(0)
GOTO C58^RMPRC21
+3 GOTO L1
DS WRITE !!
SET DA=RMPRA
SET DIE="^RMPR(664,"
SET DR="12;17"
DO ^DIE
GOTO L
POST1 ;POSTS THE COMPLETED TRANSACTION TO 664,660 AND 424
+1 SET R1=0
+2 FOR
SET R1=$ORDER(^RMPR(664,RMPRA,1,R1))
if R1'>0
QUIT
SET RMPRAR=$SELECT($PIECE(^RMPR(664,RMPRA,1,R1,0),U,13)'="":$PIECE(^(0),U,13),1:"NP")
if R1'>0
QUIT
if '$DATA(^RMPR(660,+RMPRAR,0))
GOTO UNK
DO ^RMPRE22
+3 IF $DATA(RMPRWO)
IF +RMPRWO
DO DA0^RMPR29M(RMPRDA,RMPRA)
+4 IF $PIECE(^RMPR(664,RMPRA,0),U,10)>0&($PIECE(^(0),U,11)=0)&($PIECE(^(0),U,12))
SET DA=$PIECE(^(0),U,12)
SET DIK="^RMPR(660,"
DO ^DIK
+5 IF $PIECE(^RMPR(664,RMPRA,0),U,12)&(RMPRSH>0)
SET $PIECE(^RMPR(660,$PIECE(^RMPR(664,RMPRA,0),U,12),0),U,16)=RMPRSH
SET $PIECE(^(0),U,12)=DT
Begin DoDot:1
+6 SET DA=$PIECE(^RMPR(664,RMPRA,0),U,12)
SET DIK="^RMPR(660,"
DO IX1^DIK
+7 IF $DATA(RMPRWO)
IF $DATA(^RMPR(664.2,+RMPRWO,0))
SET $PIECE(^RMPR(664.2,RMPRWO,0),U,7)=$PIECE(^(0),U,7)+RMPRSH
DO POST^RMPR29U
End DoDot:1
+8 ; Prompt for Shipment Date, mark as billable, Patch 78, Added by RMS
+9 DO ^RMPR4E23
+10 IF RMPRSH>0&('$PIECE(^RMPR(664,RMPRA,0),U,12))&($PIECE(^(0),U,11))
GOTO PSH
+11 WRITE !!,?5,$CHAR(7),"Closed out Transaction"
+12 NEW DA,DIK
SET DA=RMPRA
SET DIK="^RMPR(664,"
DO IX1^DIK
+13 GOTO EX
PSH SET RMPRB=$ORDER(^RMPR(664,RMPRA,1,0))
+1 SET X=DT
SET DIC(0)="AEQLM"
SET DLAYGO=660
SET DIC="^RMPR(660,"
+2 SET DIC("DR")=".02////^S X="_$PIECE(^RMPR(664,RMPRA,0),U,2)
+3 KILL DINUM,DD,DO
DO FILE^DICN
KILL DLAYGO
+4 SET ^RMPR(660,+Y,0)=DT_U_RMPRDFN_U_$PIECE(^RMPR(664,RMPRA,0),U)_"^X^^^^^"_$PIECE(^(0),U,4)_U_RMPR("STA")_U_$PIECE(^RMPR(664,RMPRA,1,RMPRB,0),U,15)_U_DT_U_$SELECT($PIECE(^RMPR(660,$PIECE(^RMPR(664,RMPRA,1,RMPRB,0),U,13),0),U,13):$PIECE(^(0),U,13
),1:"")
+5 SET $PIECE(^RMPR(660,+Y,0),U,14)="C"
+6 SET $PIECE(^RMPR(660,+Y,0),U,16)=$GET(RMPRSH)
+7 SET $PIECE(^RMPR(660,+Y,0),U,17)=$GET(RMPRSH)
+8 ;INITIATOR
+9 SET $PIECE(^RMPR(660,+Y,0),U,27)=$GET(DUZ)
+10 ;HCPCS code
+11 SET RMHCPC=$PIECE(^RMPR(664,RMPRA,1,RMPRB,0),U,16)
+12 if RMHCPC
SET $PIECE(^RMPR(660,+Y,0),U,22)=$PIECE(^RMPR(661.1,RMHCPC,0),U,4)
+13 SET $PIECE(^RMPR(660,+Y,1),U,4)=RMHCPC
+14 SET ^RMPR(660,+Y,"AM")=U_U_$PIECE(^RMPR(664,RMPRA,1,RMPRB,0),U,10)_U_$PIECE(^RMPR(664,RMPRA,1,RMPRB,0),U,11)
+15 SET $PIECE(^RMPR(660,+Y,"AMS"),U,1)=$GET(RGRP1)
+16 ;
+17 ;use da in ix1^dik call
+18 if $DATA(Y)
SET $PIECE(^RMPR(664,RMPRA,0),U,12)=+Y
+19 SET INX=+Y
+20 IF $DATA(RMPRWO)
IF $DATA(^RMPR(664.2,+RMPRWO,0))
NEW Y
SET $PIECE(^("AM"),U,2)=1
SET $PIECE(^RMPR(664.2,RMPRWO,0),U,7)=$PIECE(^RMPR(664.2,RMPRWO,0),U,7)+RMPRSH
DO DA0^RMPR29M(RMPRDA,RMPRA)
DO POST^RMPR29U
+21 SET DA=INX
SET DIK="^RMPR(660,"
DO IX1^DIK
+22 SET RM60LINK(INX)=""
+23 ;
+24 WRITE !!,?5,$CHAR(7),"Closed out 1358 Transaction"
+25 NEW DA,DIK
SET DA=RMPRA
SET DIK="^RMPR(664,"
DO IX1^DIK
+26 ;
+27 GOTO EX
EX DO EN1^RMPRFSH
LOCK -^RMPR(664,RMPRA,0)
IF RMPRF'=10
IF RMPRF'="E"
DO LINK^RMPRS
+1 ;added by #62
+2 ;call suspense listmanager screen for multiple suspense and items.
+3 IF $DATA(RM60LINK)
IF RMPRF="E"
IF RM68FG>1
DO MAN^RMPRPCEL
+4 ;
+5 ;do auto-link if only one suspense
+6 IF $DATA(RM60LINK)
IF RMPRF="E"
IF RM68FG=1
DO AUTO^RMPRPCEL
+7 KILL INX,RM68LINK,RM668I,RM660I,RM664DAT,RM668D10,RM60LINK,RMSHIEN,RM68LIFG
+8 ;
+9 IF $DATA(RMPRF)
IF RMPRF'=10
WRITE !!,"Enter Next Transaction to Close-out, or <RETURN> to Continue."
+10 KILL RMPR("AMT"),RMPRAR,RMPRSER,RMPRTO,RMPRCT,RMPRQT,RMPRSH,RZZZ,R1,B2,%,Y,DIC,R2,RMPRA,RMPRCTDA,DIE,DIK,DR,RMPR("DRN"),RMPR("DDT"),DCT,DIR,B3,RMPRB
KILL ^TMP($JOB)
+11 KILL RGRP,RGRP1,RGRPP
+12 IF $DATA(RMPRF)
IF RMPRF=10
QUIT
+13 KILL X
GOTO CL
+14 ;
EXIT ;KILL VARIABLES AND EXIT ROUTINE
+1 if $DATA(^TMP($JOB))&'$DATA(RHCED)
DO EN2^RMPRFSH
if $DATA(RMPRA)
LOCK -^RMPR(664,RMPRA,0)
+2 KILL PRCSCPAN,LINE,PRCSIP,RMPRAMIS,RMPRCNT,RMPRIT,RMPRIT1,RMPRU,RMPRX,RMPR("AMT"),AMT,BO,PRCSX,PRCS("A"),RMPRA1,RMPRDFN,RMPRNAM,RMPRSSN,RMPRAR
+3 KILL DCT,RMPRTO,RMPRCT,RMPRQT,RMPRSH,RZZZ,R1,B2,%,Y,DIC,R2,RMPRA,RMPRCT,RMPRI,RMPRCONT,DIR,RMX,RHCED,RHCNEW,RHCOLD
+4 KILL RMPRSER,FL,RMPRN,RMPRI1,RA,DIRUT,DA,DFN,DIE,DIK,DR,RMPR("DRN"),RMPR("DDT"),RMPR("OB"),RD,RC,RIT,RIN,RZ,RT,RF,RE,RAC,RMPRSD,DCTZ,ACT,RI,RMPRP,RMPR90,RMPRAMT,RMPRPSC,^TMP($JOB),B2,RMPRCC,B3,J,K,DIR,PQTY,RD660
+5 IF $DATA(RMPROB)
DO PRCS^RMPRPSC
if (X'["^")!(X'="^")
GOTO CL
+6 KILL RMPRF,RMPROB,PRC,RMHCPC,PRCRI,RBL,RDA,RMPRDELN,RMPRWO,RVA
QUIT
UNK WRITE !,$CHAR(7),"UNKNOWN 2319 RECORD TO UPDATE, IFCAP DAILY RECORD NOT UPDATED!"
GOTO EXIT
M4 WRITE !,$CHAR(7),"This Transaction has already been CLOSED!"
GOTO EXIT
M6 WRITE !,$CHAR(7),"This Transaction has been CANCELED!"
GOTO EXIT
