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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29C 5800 printed Apr 09, 2024@21:38:14 Page 2
RMPR29C ;PHX/JLT/HNB-COMPLETE 2529-3[ 09/29/94 11:22 AM ]
+1 ;;3.0;PROSTHETICS;**13,34**;Feb 09, 1996
CMP ;LOOKUP 2529-3 READY FOR COMPLETION
+1 KILL DIC
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+2 SET DIC="^RMPR(664.1,"
SET DIC(0)="AEQM"
+3 SET 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"")"
+4 SET DIC("W")="D EN3^RMPRD1"
+5 DO ^DIC
KILL DIC
+6 if +Y'>0
GOTO EXIT
+7 ;unable to edit if transaction is a LAB STOCK issue
+8 IF $PIECE(^RMPR(664.1,+Y,0),U,17)="C"
IF $$LAB=1
Begin DoDot:1
+9 WRITE !,"**** You are unable to EDIT this transaction....this is a LAB STOCK issue !!!",!
+10 SET RMPR29C=1
End DoDot:1
if $DATA(RMPR29C)
GOTO EXIT
+11 SET RMPRDA=+Y
IF $PIECE(^RMPR(664.1,RMPRDA,0),U,17)="C"
DO AUT
if $DATA(RMPR29C)
GOTO EXIT
+12 SET PAC=1
GOTO DISP^RMPR29D
CMA ;COMPLETE REMOTE 2529-3 REQUEST
+1 ;CALLED BY EXIT+2 IF USER WISHES TO COMPLETE ANOTHER REMOTE 2529-3
+2 ;
+3 KILL DIC
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+4 SET DIC="^RMPR(664.1,"
SET DIC(0)="AEQM"
+5 SET DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),$P(^(0),U,20) S RSTAT=$P(^(0),U,17) I RSTAT=""PC""!(RSTAT=""C"")"
+6 SET DIC("W")="D EN4^RMPRD1"
+7 DO ^DIC
KILL DIC
if +Y'>0
GOTO EXIT
+8 ;unable to edit if transaction is a LAB STOCK issue
+9 IF $PIECE(^RMPR(664.1,+Y,0),U,17)="C"
IF $$LAB=1
Begin DoDot:1
+10 WRITE !,"**** You are unable to EDIT this transaction....this is a LAB STOCK issue !!!",!
+11 SET RMPR29C=1
End DoDot:1
if $DATA(RMPR29C)
GOTO EXIT
+12 SET RMPRDA=+Y
IF $PIECE(^RMPR(664.1,RMPRDA,0),U,17)="C"
DO AUT
if $DATA(RMPR29C)
GOTO EXIT
+13 SET PNK=1
GOTO DISP^RMPR29D
CA ;CANCEL FORM 2529-3
+1 ;CALLED FROM RMPR29T
+2 ;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
+3 KILL DIR
SET DIR(0)="Y"
+4 SET DIR("A")="Do you really want to Cancel the entire 2529-3"
+5 SET DIR("B")="NO"
DO ^DIR
if $DATA(DTOUT)!(X="^")
GOTO EXIT
+6 IF +Y=0
GOTO DISP^RMPR29D
+7 LOCK +^RMPR(664.1,RMPRDA):1
IF '$TEST
WRITE !,$CHAR(7),"ANOTHER USER IS EDITING THIS RECORD!"
GOTO EXIT
+8 SET DIE="^RMPR(664.1,"
SET DA=RMPRDA
+9 SET DR="8///^S X=DT;32///@;28///@;30///@;19///@;20///@;S $P(^RMPR(664.1,DA,3),U)=DUZ;11"
+10 DO ^DIE
LOCK -^RMPR(664.1,RMPRDA)
+11 IF $DATA(DTOUT)!$DATA(Y)
GOTO EXIT
+12 DO DEL^RMPR29P(RMPRDA)
+13 ;
+14 ;THIS IS THE NEW CODE TO CANCEL A -3
+15 ;DELETE ENTRIES FROM 660, POINTER FROM 664.1
+16 ;DELETE ENTRIES FROM 664.3
+17 ;CHECK FILE 664.2 FOR POINTERS TO FILE 664, IF ANY THEN
+18 ;SEND E-MAIL TO PA'S SO THEY CAN CANCEL PO'S
+19 ;DELETE WORK ORDER ENTRY IN 664.2
+20 ;SET FLAG IN FILE 664.1 AS CANCELED AND UPDATE FIELDS.
+21 ;
+22 IF RMPRDA=""
WRITE !!,$CHAR(7),"SEE YOUR APPLICATION COORDINATOR!"
GOTO EXIT
+23 NEW RMPRB,RMPRBA,RMPRBB,RMPRBC,RMPRBD,RMPRBE
+24 SET RMPRB=0
SET RMPRBA=""
+25 FOR
SET RMPRB=$ORDER(^RMPR(664.1,RMPRDA,2,RMPRB))
if RMPRB'>0
QUIT
Begin DoDot:1
+26 ;looping through items to get pointer to 2319 record
+27 SET RMPRBA=$PIECE(^RMPR(664.1,RMPRDA,2,RMPRB,0),U,5)
+28 if RMPRBA=""
QUIT
+29 ;remove techs hours date associated with 2319
+30 SET RMPRBE=0
+31 FOR
SET RMPRBE=$ORDER(^RMPR(664.3,"C",RMPRBA,RMPRBE))
if RMPRBE'>0
QUIT
Begin DoDot:2
+32 SET DIK="^RMPR(664.3,"
SET DA=RMPRBE
DO ^DIK
KILL DIK,DA
End DoDot:2
+33 ;update 2319
+34 SET DIK="^RMPR(660,"
SET DA=RMPRBA
DO ^DIK
KILL DIK,DA
+35 ;Get work order ien, and ien to 664
+36 SET RMPR2DA=$PIECE(^RMPR(664.1,RMPRDA,2,RMPRB,0),U,6)
+37 if 'RMPR2DA
QUIT
+38 SET RMPRBC=0
+39 SET RMPRBC=$ORDER(^RMPR(664.2,RMPR2DA,1,RMPRBC))
if RMPRBC'>0
QUIT
+40 SET RMPRBD=$PIECE(^RMPR(664.2,RMPR2DA,1,RMPRBC,0),U,11)
+41 if RMPRBD=""
QUIT
+42 DO CA21^RMPR29M(RMPRDA,RMPRBD)
End DoDot:1
+43 ;now delete the work order
+44 IF '$GET(RMPR2DA)
WRITE !!,$CHAR(7),?5,"2529-3 Canceled"
GOTO EXIT
+45 SET DIK="^RMPR(664.2,"
SET DA=RMPR2DA
DO ^DIK
KILL DIK,DA
+46 ;Update the 2529-3
+47 SET $PIECE(^RMPR(664.1,RMPRDA,0),U,24)=""
+48 SET DIE="^RMPR(664.1,"
SET DA=RMPRDA
+49 SET DR=".09///@;15///@;16///^S X=""CA"""
DO ^DIE
+50 WRITE !!,$CHAR(7),?5,"2529-3 Canceled"
+51 GOTO EXIT
+52 ;END
RT ;RETURN FORM 2529-3 TO TECHNICIAN
+1 ;CALLED FROM RMPR29T
+2 ;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1.
+3 KILL DIR
SET DIR(0)="Y"
+4 SET DIR("A")="Do you really want to return the 2529-3 to the Lab"
+5 SET DIR("B")="NO"
DO ^DIR
if $DATA(DTOUT)!(X="^")
GOTO EXIT
+6 IF +Y=0
GOTO DISP^RMPR29D
+7 ;lock, edit
+8 LOCK +^RMPR(664.1,RMPRDA):1
IF '$TEST
WRITE !,$CHAR(7),"ANOTHER USER IS EDITING THIS RECORD!"
GOTO EXIT
+9 SET DIE="^RMPR(664.1,"
SET DA=RMPRDA
+10 SET DR="10///^S X=DT;S $P(^RMPR(664.1,DA,7),U,3)=DUZ;11.5"
+11 DO ^DIE
LOCK -^RMPR(664.1,RMPRDA)
+12 ;unlock
+13 if $DATA(DTOUT)!$DATA(Y)
GOTO EXIT
+14 KILL DR
SET DR="16///^S X=""R"""
DO ^DIE
+15 WRITE !!,$CHAR(7),?5,"2529-3 Returned to Lab and Notification sent!!"
+16 DO RTM^RMPR29M
EXIT ;REMOTE 2529-3 EXIT
+1 ;CALLED FROM RMPR29T
+2 ;VARIABLES REQUIRED - NONE
+3 IF $DATA(PNK)
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Would you like to Process another 2529-3 Request"
DO ^DIR
IF +Y=1
GOTO CMA
+4 IF $DATA(PDCA)
IF $DATA(RMPRDA)
Begin DoDot:1
+5 SET R=RMPRDA
SET RMPRDA=$ORDER(PDCA(RMPRDA))
SET Y=RMPRDA
+6 IF $GET(RMPRDA)<1
SET RMPRDA=$ORDER(PREV(-RMPRDA))
+7 KILL PDCA(R),PREV(-R),R
End DoDot:1
DO ASM^RMPR29S
+8 IF '$DATA(PDCA)
KILL RMPRDA
+9 KILL 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
+10 KILL RR,RSTAT,RT,RTX,RU,RZ,RZP,XMSUB,XMTEXT,XMY,X,Y
+11 QUIT
AUT ;AUDIT 2529-3 REOPEN
+1 ;REQUIRED VARIABLE: RMPRDA - ENTRY NUMBER IN FILE 664.1
+2 ;CALLED FROM CMP+5 AND CMA+2, WHICH HAVE CHECKED AND FOUND RMPRDA IS
+3 ;A VALID ENTRY NUMBER FOR A COMPLETED VAF 10-2529-3.
+4 ;SETS THE VARIABLE RMPR29C EQUAL TO 1 IF USER DOES NOT WANT TO REOPEN
+5 ;THE VAF 10-2529-3.
+6 KILL RMPR29C,DIR
SET DIR(0)="Y"
+7 SET DIR("A")="This 2529-3 has been Completed. Would you like to re-open the 2529-3"
SET DIR("B")="Yes"
+8 DO ^DIR
+9 IF $DATA(DIRUT)!($DATA(DTOUT))!(+Y=0)
SET RMPR29C=1
QUIT
+10 DO NOW^%DTC
SET (NX,X)=%
KILL %
+11 SET DIC("P")="664.129DA"
SET DA(1)=RMPRDA
+12 SET DIC="^RMPR(664.1,"_RMPRDA_",8,"
SET DIC(0)="LZ"
+13 SET DLAYGO=664.1
DO FILE^DICN
KILL DLAYGO,DIC
+14 LOCK +^RMPR(664.1,RMPRDA):1
IF '$TEST
WRITE !,$CHAR(7),"ANOTHER USER IS EDITING THIS REOCRD!"
GOTO EXIT
+15 IF +Y
SET DIE="^RMPR(664.1,"_RMPRDA_",8,"
SET DA(1)=RMPRDA
SET DA=+Y
SET DR=".01///^S X=NX;5////^S X=DUZ;W $C(7),!!,?5,""2529-3 has been re-opened"";4"
DO ^DIE
+16 SET DIE="^RMPR(664.1,"
SET DA=RMPRDA
+17 SET DR="22///@;23///@;16///^S X=""PC"""
+18 DO ^DIE
LOCK -^RMPR(664.1,RMPRDA)
+19 QUIT
LAB() ;check for lab stock issue, if it is, access not allowed.
+1 SET RZ=$ORDER(^RMPR(664.1,+Y,2,0))
IF $DATA(^RMPR(664.1,+Y,2,RZ,3))
QUIT 1
+2 QUIT -1
