source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRE21.m@ 1093

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