source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29C.m@ 824

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