135 lines
5.5 KiB
Mathematica
135 lines
5.5 KiB
Mathematica
RMPR29C ;PHX/JLT/HNB-COMPLETE 2529-3[ 09/29/94 11:22 AM ]
|
|
;;3.0;PROSTHETICS;**13,34**;Feb 09, 1996
|
|
CMP ;LOOKUP 2529-3 READY FOR COMPLETION
|
|
K DIC D DIV4^RMPRSIT G:$D(X) EXIT
|
|
S DIC="^RMPR(664.1,",DIC(0)="AEQM"
|
|
S DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),'$P(^(0),U,20) S RSTAT=$P(^(0),U,17) I RSTAT=""PC""!(RSTAT=""A"")!(RSTAT=""C"")!(RSTAT=""R"")"
|
|
S DIC("W")="D EN3^RMPRD1"
|
|
D ^DIC K DIC
|
|
G:+Y'>0 EXIT
|
|
;unable to edit if transaction is a LAB STOCK issue
|
|
I $P(^RMPR(664.1,+Y,0),U,17)="C",$$LAB=1 D G:$D(RMPR29C) EXIT
|
|
. W !,"**** You are unable to EDIT this transaction....this is a LAB STOCK issue !!!",!
|
|
. S RMPR29C=1
|
|
S RMPRDA=+Y I $P(^RMPR(664.1,RMPRDA,0),U,17)="C" D AUT G:$D(RMPR29C) EXIT
|
|
S PAC=1 G DISP^RMPR29D
|
|
CMA ;COMPLETE REMOTE 2529-3 REQUEST
|
|
;CALLED BY EXIT+2 IF USER WISHES TO COMPLETE ANOTHER REMOTE 2529-3
|
|
;
|
|
K DIC D DIV4^RMPRSIT G:$D(X) EXIT
|
|
S DIC="^RMPR(664.1,",DIC(0)="AEQM"
|
|
S DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),$P(^(0),U,20) S RSTAT=$P(^(0),U,17) I RSTAT=""PC""!(RSTAT=""C"")"
|
|
S DIC("W")="D EN4^RMPRD1"
|
|
D ^DIC K DIC G:+Y'>0 EXIT
|
|
;unable to edit if transaction is a LAB STOCK issue
|
|
I $P(^RMPR(664.1,+Y,0),U,17)="C",$$LAB=1 D G:$D(RMPR29C) EXIT
|
|
. W !,"**** You are unable to EDIT this transaction....this is a LAB STOCK issue !!!",!
|
|
. S RMPR29C=1
|
|
S RMPRDA=+Y I $P(^RMPR(664.1,RMPRDA,0),U,17)="C" D AUT G:$D(RMPR29C) EXIT
|
|
S PNK=1 G DISP^RMPR29D
|
|
CA ;CANCEL FORM 2529-3
|
|
;CALLED FROM RMPR29T
|
|
;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
|
|
K DIR S DIR(0)="Y"
|
|
S DIR("A")="Do you really want to Cancel the entire 2529-3"
|
|
S DIR("B")="NO" D ^DIR G:$D(DTOUT)!(X="^") EXIT
|
|
I +Y=0 G DISP^RMPR29D
|
|
L +^RMPR(664.1,RMPRDA):1 I '$T W !,$C(7),"ANOTHER USER IS EDITING THIS RECORD!" G EXIT
|
|
S DIE="^RMPR(664.1,",DA=RMPRDA
|
|
S DR="8///^S X=DT;32///@;28///@;30///@;19///@;20///@;S $P(^RMPR(664.1,DA,3),U)=DUZ;11"
|
|
D ^DIE L -^RMPR(664.1,RMPRDA)
|
|
I $D(DTOUT)!$D(Y) G EXIT
|
|
D DEL^RMPR29P(RMPRDA)
|
|
;
|
|
;THIS IS THE NEW CODE TO CANCEL A -3
|
|
;DELETE ENTRIES FROM 660, POINTER FROM 664.1
|
|
;DELETE ENTRIES FROM 664.3
|
|
;CHECK FILE 664.2 FOR POINTERS TO FILE 664, IF ANY THEN
|
|
;SEND E-MAIL TO PA'S SO THEY CAN CANCEL PO'S
|
|
;DELETE WORK ORDER ENTRY IN 664.2
|
|
;SET FLAG IN FILE 664.1 AS CANCELED AND UPDATE FIELDS.
|
|
;
|
|
I RMPRDA="" W !!,$C(7),"SEE YOUR APPLICATION COORDINATOR!" G EXIT
|
|
N RMPRB,RMPRBA,RMPRBB,RMPRBC,RMPRBD,RMPRBE
|
|
S RMPRB=0,RMPRBA=""
|
|
F S RMPRB=$O(^RMPR(664.1,RMPRDA,2,RMPRB)) Q:RMPRB'>0 D
|
|
.;looping through items to get pointer to 2319 record
|
|
.S RMPRBA=$P(^RMPR(664.1,RMPRDA,2,RMPRB,0),U,5)
|
|
.Q:RMPRBA=""
|
|
.;remove techs hours date associated with 2319
|
|
.S RMPRBE=0
|
|
.F S RMPRBE=$O(^RMPR(664.3,"C",RMPRBA,RMPRBE)) Q:RMPRBE'>0 D
|
|
..S DIK="^RMPR(664.3,",DA=RMPRBE D ^DIK K DIK,DA
|
|
.;update 2319
|
|
.S DIK="^RMPR(660,",DA=RMPRBA D ^DIK K DIK,DA
|
|
.;Get work order ien, and ien to 664
|
|
.S RMPR2DA=$P(^RMPR(664.1,RMPRDA,2,RMPRB,0),U,6)
|
|
.Q:'RMPR2DA
|
|
.S RMPRBC=0
|
|
.S RMPRBC=$O(^RMPR(664.2,RMPR2DA,1,RMPRBC)) Q:RMPRBC'>0
|
|
.S RMPRBD=$P(^RMPR(664.2,RMPR2DA,1,RMPRBC,0),U,11)
|
|
.Q:RMPRBD=""
|
|
.D CA21^RMPR29M(RMPRDA,RMPRBD)
|
|
;now delete the work order
|
|
I '$G(RMPR2DA) W !!,$C(7),?5,"2529-3 Canceled" G EXIT
|
|
S DIK="^RMPR(664.2,",DA=RMPR2DA D ^DIK K DIK,DA
|
|
;Update the 2529-3
|
|
S $P(^RMPR(664.1,RMPRDA,0),U,24)=""
|
|
S DIE="^RMPR(664.1,",DA=RMPRDA
|
|
S DR=".09///@;15///@;16///^S X=""CA""" D ^DIE
|
|
W !!,$C(7),?5,"2529-3 Canceled"
|
|
G EXIT
|
|
;END
|
|
RT ;RETURN FORM 2529-3 TO TECHNICIAN
|
|
;CALLED FROM RMPR29T
|
|
;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1.
|
|
K DIR S DIR(0)="Y"
|
|
S DIR("A")="Do you really want to return the 2529-3 to the Lab"
|
|
S DIR("B")="NO" D ^DIR G:$D(DTOUT)!(X="^") EXIT
|
|
I +Y=0 G DISP^RMPR29D
|
|
;lock, edit
|
|
L +^RMPR(664.1,RMPRDA):1 I '$T W !,$C(7),"ANOTHER USER IS EDITING THIS RECORD!" G EXIT
|
|
S DIE="^RMPR(664.1,",DA=RMPRDA
|
|
S DR="10///^S X=DT;S $P(^RMPR(664.1,DA,7),U,3)=DUZ;11.5"
|
|
D ^DIE L -^RMPR(664.1,RMPRDA)
|
|
;unlock
|
|
G:$D(DTOUT)!$D(Y) EXIT
|
|
K DR S DR="16///^S X=""R""" D ^DIE
|
|
W !!,$C(7),?5,"2529-3 Returned to Lab and Notification sent!!"
|
|
D RTM^RMPR29M
|
|
EXIT ;REMOTE 2529-3 EXIT
|
|
;CALLED FROM RMPR29T
|
|
;VARIABLES REQUIRED - NONE
|
|
I $D(PNK) S DIR(0)="Y",DIR("B")="YES" S DIR("A")="Would you like to Process another 2529-3 Request" D ^DIR I +Y=1 G CMA
|
|
I $D(PDCA),$D(RMPRDA) D D ASM^RMPR29S
|
|
.S R=RMPRDA,RMPRDA=$O(PDCA(RMPRDA)),Y=RMPRDA
|
|
.I $G(RMPRDA)<1 S RMPRDA=$O(PREV(-RMPRDA))
|
|
.K PDCA(R),PREV(-R),R
|
|
I '$D(PDCA) K RMPRDA
|
|
K DA,DA32,DA33,DA660,DIC,DIE,DIK,DIQ,DIR,DIRUT,DR,DTOUT,HLD,NX,PAC,PAGE,PDA,PEMP,PNK,RA,RDA,RI,RIA,RMPR29C,RMPRREF,RMPRWO
|
|
K RR,RSTAT,RT,RTX,RU,RZ,RZP,XMSUB,XMTEXT,XMY,X,Y
|
|
Q
|
|
AUT ;AUDIT 2529-3 REOPEN
|
|
;REQUIRED VARIABLE: RMPRDA - ENTRY NUMBER IN FILE 664.1
|
|
;CALLED FROM CMP+5 AND CMA+2, WHICH HAVE CHECKED AND FOUND RMPRDA IS
|
|
;A VALID ENTRY NUMBER FOR A COMPLETED VAF 10-2529-3.
|
|
;SETS THE VARIABLE RMPR29C EQUAL TO 1 IF USER DOES NOT WANT TO REOPEN
|
|
;THE VAF 10-2529-3.
|
|
K RMPR29C,DIR S DIR(0)="Y"
|
|
S DIR("A")="This 2529-3 has been Completed. Would you like to re-open the 2529-3",DIR("B")="Yes"
|
|
D ^DIR
|
|
I $D(DIRUT)!($D(DTOUT))!(+Y=0) S RMPR29C=1 Q
|
|
D NOW^%DTC S (NX,X)=% K %
|
|
S DIC("P")="664.129DA",DA(1)=RMPRDA
|
|
S DIC="^RMPR(664.1,"_RMPRDA_",8,",DIC(0)="LZ"
|
|
S DLAYGO=664.1 D FILE^DICN K DLAYGO,DIC
|
|
L +^RMPR(664.1,RMPRDA):1 I '$T W !,$C(7),"ANOTHER USER IS EDITING THIS REOCRD!" G EXIT
|
|
I +Y S DIE="^RMPR(664.1,"_RMPRDA_",8,",DA(1)=RMPRDA,DA=+Y,DR=".01///^S X=NX;5////^S X=DUZ;W $C(7),!!,?5,""2529-3 has been re-opened"";4" D ^DIE
|
|
S DIE="^RMPR(664.1,",DA=RMPRDA
|
|
S DR="22///@;23///@;16///^S X=""PC"""
|
|
D ^DIE L -^RMPR(664.1,RMPRDA)
|
|
Q
|
|
LAB() ;check for lab stock issue, if it is, access not allowed.
|
|
S RZ=$O(^RMPR(664.1,+Y,2,0)) I $D(^RMPR(664.1,+Y,2,RZ,3)) Q 1
|
|
Q -1
|