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