| 1 | RMPR5NRE ;HIN/RVD-PROS INVENTORY REMOVE UTILITY ;2/11/98
|
|---|
| 2 | ;;3.0;PROSTHETICS;**33,37**;Feb 09, 1996
|
|---|
| 3 | D DIV4^RMPRSIT I $D(Y),(Y<0) K DIC("B") Q
|
|---|
| 4 | S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
|
|---|
| 5 | W @IOF
|
|---|
| 6 | ;
|
|---|
| 7 | LOC ;get location
|
|---|
| 8 | S RMFLG=0
|
|---|
| 9 | S DZ="??",D="B"
|
|---|
| 10 | K DTOUT,DUOUT,DIC("B"),DIC("S")
|
|---|
| 11 | S DIC="^RMPR(661.3,",DIC(0)="AEQM"
|
|---|
| 12 | S DIC("S")="I $P(^RMPR(661.3,+Y,0),U,3)=RMPR(""STA"")"
|
|---|
| 13 | S DIC(0)="AEQM"
|
|---|
| 14 | ;I $D(^RMPR(661.3,"B")) D DQ^DICQ
|
|---|
| 15 | S DIC("A")="Enter LOCATION: " D MIX^DIC1
|
|---|
| 16 | G:Y'>0!$D(DTOUT)!$D(DUOUT) EXIT S RMLODA=+Y
|
|---|
| 17 | S RMLOC=$P($G(^RMPR(661.3,+Y,0)),U,1)
|
|---|
| 18 | ;
|
|---|
| 19 | LIST ;list current HCPCS @ this Location
|
|---|
| 20 | K DTOUT,DUOUT,DIC("S"),DIR
|
|---|
| 21 | S DIC("A")="Select HCPCS to Remove: "
|
|---|
| 22 | S DA(1)=RMLODA,DIC(0)="AEMQ",DIC("W")="S RZ=$P(^RMPR(661.3,RMLODA,1,+Y,0),U,1) I RZ W ?15,$P(^RMPR(661.1,RZ,0),U,2)"
|
|---|
| 23 | S DIC="^RMPR(661.3,"_RMLODA_",1," D ^DIC
|
|---|
| 24 | I +Y'>0!$D(DTOUT)!$D(DUOUT) W !,"** No HCPCS selected..." H 2 G LOC
|
|---|
| 25 | S RMHCDA=+Y,RMDAHC=$P(^RMPR(661.3,RMLODA,1,+Y,0),U,1),RMHCPC=$P(^RMPR(661.1,RMDAHC,0),U,1)
|
|---|
| 26 | ;
|
|---|
| 27 | ITEM G:'RMHCDA LIST K DIC
|
|---|
| 28 | S DA(1)=RMHCDA,DA(2)=RMLODA,DZ="??",D="B"
|
|---|
| 29 | S DIC("A")="Enter Item to Remove: "
|
|---|
| 30 | S DIC="^RMPR(661.3,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="AEMNQ"
|
|---|
| 31 | ;I $D(^RMPR(661.1,RMDAHC,3,"B")) D DQ^DICQ
|
|---|
| 32 | D ^DIC G:Y'>0!$D(DTOUT)!$D(DUOUT) LOC S RMITDA=+Y
|
|---|
| 33 | S RM3=^RMPR(661.3,RMLODA,1,RMHCDA,1,RMITDA,0)
|
|---|
| 34 | S RMIT=$P(RM3,U,1),RMBA=$P(RM3,U,2),RMCO=$P(RM3,U,3),RMSO=$P(RM3,U,9)
|
|---|
| 35 | S RMDAIT=$P(RMIT,"-",2)
|
|---|
| 36 | S RM1=^RMPR(661.1,RMDAHC,3,RMDAIT,0)
|
|---|
| 37 | S DIR("A")="Are you sure you want to DEACTIVATE/REMOVE this item (Y/N)"
|
|---|
| 38 | S DIR(0)="Y" D ^DIR G:$D(DTOUT)!(+Y=0)!$D(DUOUT) LOC
|
|---|
| 39 | S DA=RMITDA,DA(2)=RMLODA,DA(1)=RMHCDA,DIK=DIC D ^DIK
|
|---|
| 40 | S DA(1)=RMLODA
|
|---|
| 41 | I '$D(^RMPR(661.3,RMLODA,1,RMHCDA,1,"B")) S DIK="^RMPR(661.3,"_DA(1)_",1,",DA=RMHCDA D ^DIK
|
|---|
| 42 | I '$D(^RMPR(661.3,"C",RMDAHC)) S RMFLG=1
|
|---|
| 43 | W !,"**** Item has been removed from Location ",$P(^RMPR(661.3,RMLODA,0),U,1),!
|
|---|
| 44 | ;
|
|---|
| 45 | ;create item stattistics in file 661.2
|
|---|
| 46 | STAT D BAL^RMPR5NU1
|
|---|
| 47 | K DD,DO S DIC="^RMPR(661.2,",DIC(0)="L",X=DT,DLAYGO=661.2 D FILE^DICN
|
|---|
| 48 | G:$D(DTOUT)!(Y'>0) LOC S DA=+Y
|
|---|
| 49 | I 'RMFLG D
|
|---|
| 50 | .S RMMESF="Item Deactivated by "_$E($P(^VA(200,DUZ,0),U,1),1,15)_": (-"_RMBA_")"
|
|---|
| 51 | .S ^RMPR(661.2,DA,0)=DT_"^^^"_RMDAHC_"^^^"_DUZ_"^^"_RMIT_"^^^"_RMTOBA_"^"_RMMESF_"^"_$J(RMTOCO,0,2)_"^"_RMPR("STA")_"^"_RMLODA_"^"_$J(RMAVA,0,2)
|
|---|
| 52 | .S DIK=DIC D IX1^DIK
|
|---|
| 53 | ;
|
|---|
| 54 | DEAC I RMFLG D
|
|---|
| 55 | .S RMMESF="Deactivated by "_$E($P(^VA(200,DUZ,0),U,1),1,15)_": ("
|
|---|
| 56 | .S ^RMPR(661.2,DA,0)=DT_"^^^"_RMDAHC_"^^^"_DUZ_"^^"_RMIT_"^^^"_RMTOBA_"^"_RMMESF_"^"_$J(RMTOCO,0,2)_"^"_RMPR("STA")_"^"_RMLODA_"^"_$J(RMAVA,0,2)
|
|---|
| 57 | .S DIK=DIC D IX1^DIK
|
|---|
| 58 | .S $P(^RMPR(661.1,RMDAHC,0),U,9)=0 W !,"**** HCPCS has been deactivated from Pros Inventory...."
|
|---|
| 59 | H 1 G LOC
|
|---|
| 60 | ;
|
|---|
| 61 | EXIT ;MAIN EXIT POINT
|
|---|
| 62 | N RMPRSITE,RMPR D KILL^XUSCLEAN
|
|---|
| 63 | Q
|
|---|
