source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRRET2.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1RMPRRET2 ;PHX/RFM-RETURN ITEM FROM FILE 661 ;8/29/1994
2 ;;3.0;PROSTHETICS;;Feb 09, 1996
3EN K RMPRINV,DIC,IEN S DIC=661,DIC(0)="AEQMZ",DIC("A")="Select ITEM: " D ^DIC G:Y<0 EXIT S RMPRITEM=+Y,PRCP("ITEM")=$P(Y,U,2) I $P(^RMPR(669.9,RMPRSITE,0),U,3),$D(^PRCP(445,"AE",+PRCP("ITEM"))) G INV
4EN1 K DIR S DIR(0)="660.1,3",DIR("A")="QTY",DIR("B")=1 D ^DIR G:$$CK EXIT I X="" W !,"Enter `^` to exit" G EN1
5 S (RMPRQTY,PRCP("QTY"))=X
6 S RMPRCST=0 K DIR S DIR(0)="660.1,4",DIR("A")="UNIT COST",DIR("B")=0 D ^DIR G:$$CK EXIT S (RMPRCOST,RMPRCST)=X
7RETU K DIR S DIR(0)="660.1,13",DIR("A")="RETURNED STATUS",DIR("B")="RETURNED" D ^DIR G:$$CK EXIT I X="" W !,"Enter the Returned Status or `^` to exit" G RETU
8 S RMPRSTAT=+Y
9SER K DIR S DIR(0)="660.1,5",DIR("A")="SERIAL NO." D ^DIR G:$$CK EXIT S RMPRSER=X
10 K DIR S DIR(0)="660.1,10",DIR("B")="TODAY" D ^DIR G:$$CK!(Y<0) EXIT S RMPRDRET=+Y
11POS K DD,DO
12 S DIC="^RMPR(660.1,",DIC(0)="L",X=DT,DLAYGO="660.1" D FILE^DICN
13 K DLAYGO
14 G:Y<0 EXIT S IEN=+Y,^RMPR(660.1,IEN,0)=DT_U_DFN_U_RMPRITEM_U_RMPRQTY_U_RMPRCST_U_RMPRSER_"^^^"_2_"^^"_RMPRDRET_U_$G(RMPRINV)_U_U_RMPRSTAT_U_RMPR("STA"),DIK=DIC,DA=IEN D IX1^DIK
15 I $D(RMPRINV) S PRCP("TYP")="A" D ^PRCPUSA I $D(PRCP("ITEM")) W !,?5,$C(7),"Error encountered while trying to post this item to GIP.",!,?5,"<Entry Deleted>" S DA=IEN,DIK="^RMPR(660.1," D ^DIK
16 K RMPRINV W !! G EN^RMPRRET1
17CK() Q $D(DUOUT)!($D(DTOUT))
18INV S %=1 W !!,"Would you like to add this item back into inventory" D YN^DICN G:%<0 EXIT G:%=2 EN1
19 I %=0 W !!,"Enter `YES` to add item back into inventory, `NO` to not",! G INV
20 K DIC S DIC="^PRCP(445,",DIC(0)="AEQM",DIC("S")="I $D(^PRCP(445,""AE"",PRCP(""ITEM""),+Y))",DIC("A")="Select INVENTORY POINT: ",PRCPPRIV=1 D ^DIC
21 I +Y'>0 W !!,?5,$C(7),"Deleted... Item not posted to G.I.P" G EXIT
22 S (RMPRINV,PRCP("I"))=+Y G EN1
23EXIT I '$D(IEN) W !!,?5,$C(7),"Deleted..."
24 N RMPR,RMPRSIT D KILL^XUSCLEAN Q
Note: See TracBrowser for help on using the repository browser.