Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRDP

RMPRDP.m

Go to the documentation of this file.
  1. RMPRDP ;PHX/HNC-RECORD PICKUP AND DELIVERY CHARGES ;8/29/1994
  1. ;;3.0;PROSTHETICS;**24,34,41,62**;Feb 09, 1996
  1. ;RVD patch #62 - PCE interface
  1. EN ;ENTRY POINT FOR PICKUP AND DELIVERY. CALLED FROM RMPROP.
  1. K ^TMP($J)
  1. D DIV4^RMPRSIT G:$D(X) EXIT
  1. S PRCS("A")="Select OBLIGATION NUMBER: " D EN1^PRCS58 G:Y=-1 EXIT S RMPROB=$P(Y,U,2) K PRCS("A") D BAL^RMPRPSC
  1. A S RMPRF=99 W !,"This will Post Pickup and Delivery Charges to the 1358 and 10-2319 ",!
  1. S %=1 R "Do you wish to Continue" D YN^DICN S RMPRACT=$S(%=-1:"EXIT",%=1:"ADD",%=2:"EXIT",%=0:"HLP",1:"EXIT") K:(%=2)!(%=-1) RMPROB G @RMPRACT
  1. ADD D GETPAT^RMPRUTIL G:'$D(RMPRDFN) EXIT S RMPRFLAG=1 S RMPRBAC1=1 D ^RMPRPAT I $D(RMPRKILL) W !,"Deleted..." G EXIT
  1. S X=DT,DIC="^RMPR(664,",DIC(0)="AEQML",DLAYGO=664,DIC("DR")="1////^S X=RMPRDFN" K DINUM,DD,DO D FILE^DICN K DLAYGO Q:Y<0 S (RMPRK,RMPRA)=+Y S $P(^RMPR(664,+Y,0),U,14)=RMPR("STA")
  1. ;added for PSAS HCPCS prompt
  1. HC K DIR,Y,DA S DIR(0)="660,4.5",DIR("A")="Enter PSAS HCPCS" D ^DIR G:$D(DUOUT)!($D(DTOUT)) KILL I X="" W $C(7)," ??" G HC
  1. S (X,RMHCPC)=+Y,RMTYPE="X",RDA=RMHCPC_"^"_RMTYPE_"^C^"_664
  1. CPT D CPT^RMPRCPTU(RDA)
  1. S DIE=DIC,DA=RMPRA,DR="4;10////^S X=DUZ;11R~UNIT COST;14REMARKS" D ^DIE
  1. I $D(DTOUT)!($D(Y)'=0) W !,$C(7),$C(7),"Please Try Later!" G KILL
  1. PD K DIR,Y,DA S DIR(0)="660,6.5",DIR("A")="Select PICKUP OR DELIVERY" D ^DIR G:$D(DUOUT)!($D(DTOUT)) KILL I X="" W $C(7)," ??" G PD
  1. S RMPRPD=Y
  1. PC K DIR,Y S DIR(0)="660,62" D ^DIR G:$D(DUOUT)!($D(DTOUT)) KILL S RMPREL=Y
  1. SC K DIR I RMPREL=4 S DIR(0)="660,63" D ^DIR G:$D(DTOUT)!($D(DUOUT)) KILL S RMPRSE=Y K DIR
  1. POST S %=2 R !,"Are you ready to POST to IFCAP and 10-2319 now" D YN^DICN G:$D(DTOUT) KILL G:%=1 FILE G:%=-1 DEL
  1. W !!,"This will post an Est. $",$J($P(^RMPR(664,RMPRA,0),U,10),0,2)," on the 1358 Transaction and,",!,"$",$J($P(^(0),U,10),0,2)," on the 10-2319 Record.",!,"Type '^' to delete and exit.",! G POST
  1. FILE W !,"Posting Now..."
  1. S X=RMPROB_U_DT_U_$P(^RMPR(664,RMPRA,0),U,10)_U_U_$E($P(RMPRNAM,",",1),1,6)_","_$E(RMPRSSN,6,9)_U_$P(^(0),U,13)
  1. S PRCS("TYPE")="FB" K DO,DD,D0 D EN2^PRCS58 G:+Y'=1 ERROR S RMPRTN=$P(Y,U,2),RMPRTRN=$P(^PRC(424,RMPRTN,0),U,1)
  1. W !?5,"1358 Transaction has been assigned Number: ",RMPRTRN
  1. ;I $Y>18 K DIR S DIR(0)="FAO^0:0",DIR("A")="Press 'RETURN' to continue." D ^DIR K DIR
  1. S RMPRV=$P(^RMPR(664,RMPRA,0),U,4),$P(^RMPR(664,RMPRA,0),U,7)=RMPRTRN,$P(^RMPR(664,RMPRA,0),U,6)=PRCSCPAN S DA=RMPRA,DIK="^RMPR(664," D IX1^DIK
  1. S X=DT,DIC="^RMPR(660,",DIC(0)="LQ",X=DT,DLAYGO=660 K DINUM,DO,DD D FILE^DICN S RMPR660=+Y K DLAYGO
  1. S ^RMPR(660,RMPR660,0)=DT_U_RMPRDFN_U_DT_U_"X"_"^^^^^"_RMPRV_U_RMPR("STA")_"^^^9^C^^"_$P(^RMPR(664,RMPRA,0),U,10)_U_$P(^RMPR(664,RMPRA,0),U,10)_U_$P(^(0),U,13)_"^^^^^^^^"_RMPRPD_U_DUZ
  1. S ^RMPR(660,RMPR660,1)=RMPRTRN_"^^^"_RMHCPC_"^^"_RMCPT,^("AM")=U_U_RMPREL_U_$S($D(RMPRSE):RMPRSE,1:"")
  1. L +^RMPR(669.9,RMPRSITE,0):999 I $T=0 S RMPRG=DT_99 G DIK60
  1. S RMPRG=$P(^RMPR(669.9,RMPRSITE,0),U,7),RMPRG=RMPRG-1
  1. S $P(^RMPR(669.9,RMPRSITE,0),U,7)=RMPRG L -^RMPR(669.9,RMPRSITE,0)
  1. S $P(^RMPR(660,RMPR660,"AMS"),U,1)=RMPRG
  1. DIK60 S DIK="^RMPR(660,",DA=RMPR660 D IX1^DIK
  1. S $P(^RMPR(664,RMPRA,0),U,3)=RMPROB,$P(^(0),U,12)=RMPR660,$P(^RMPR(664,RMPRA,2),U,4)="OTHER" S DA=RMPRA,DIK="^RMPR(664," D IX1^DIK
  1. ;
  1. W !?5,"Updated 10-2319 Record"
  1. ;
  1. ;set temp global for suspense link, added in patch #62
  1. S ^TMP($J,"RMPRPCE",660,RMPR660)=RMPRG_"^"_$G(RMPRDFN)
  1. D LINK^RMPRS
  1. G EXIT
  1. DEL S %=2 R !,"Do you want to Delete this Transaction" D YN^DICN G:%=1!(%<0) KILL I %=0 W !,"Enter `YES` to delete the transaction, `NO` to continue."
  1. G POST
  1. HLP W !,"This will create a 1358 Daily Transaction and post to Veteran's 10-2319 Record that AMIS will be counted from.",! G A
  1. ERROR W !,$C(7),$C(7),?5,"*** PLEASE CONTACT YOUR FISCAL SERVICE ***",!,?5,Y
  1. KILL S DA=RMPRK,DIK="^RMPR(664," D ^DIK K DIR W !,$C(7),?20,"Deleted..."
  1. S DIR(0)="E" D ^DIR
  1. EXIT K RMPRKILL,RMPRF,DIR,PRCSIP,RMPRDOB,RMPRFLAG,PRCSCPAN,PRCS("TYPE"),RMPRSE,RMPRV,DA,%,DIE,DIRUT,DTOUT,RMPRACT,RMPREL,RMPRK,RMPRTN,RMPRTRN,RMPRA,RMPRDFN,RMPRNAM,RMPRSSN,RMPRPD,RMPRSC,RMPRPC,RMPR660,DIK,DIC,DR,Y
  1. I $D(RMPROB) W @IOF D PRCS^RMPRPSC G:X'["^" A
  1. K ^TMP($J)
  1. K RMPROB,PRC,PRCS,RBL,RDA,RVA,RX,RMCPT,RMHCPC,RMPRBAC1,RMPRBACK,RMPRSSNE,PRCRI Q