source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29C.m@ 1764

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1RMPR29C ;PHX/JLT/HNB-COMPLETE 2529-3[ 09/29/94 11:22 AM ]
2 ;;3.0;PROSTHETICS;**13,34**;Feb 09, 1996
3CMP ;LOOKUP 2529-3 READY FOR COMPLETION
4 K DIC D DIV4^RMPRSIT G:$D(X) EXIT
5 S DIC="^RMPR(664.1,",DIC(0)="AEQM"
6 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"")"
7 S DIC("W")="D EN3^RMPRD1"
8 D ^DIC K DIC
9 G:+Y'>0 EXIT
10 ;unable to edit if transaction is a LAB STOCK issue
11 I $P(^RMPR(664.1,+Y,0),U,17)="C",$$LAB=1 D G:$D(RMPR29C) EXIT
12 . W !,"**** You are unable to EDIT this transaction....this is a LAB STOCK issue !!!",!
13 . S RMPR29C=1
14 S RMPRDA=+Y I $P(^RMPR(664.1,RMPRDA,0),U,17)="C" D AUT G:$D(RMPR29C) EXIT
15 S PAC=1 G DISP^RMPR29D
16CMA ;COMPLETE REMOTE 2529-3 REQUEST
17 ;CALLED BY EXIT+2 IF USER WISHES TO COMPLETE ANOTHER REMOTE 2529-3
18 ;
19 K DIC D DIV4^RMPRSIT G:$D(X) EXIT
20 S DIC="^RMPR(664.1,",DIC(0)="AEQM"
21 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"")"
22 S DIC("W")="D EN4^RMPRD1"
23 D ^DIC K DIC G:+Y'>0 EXIT
24 ;unable to edit if transaction is a LAB STOCK issue
25 I $P(^RMPR(664.1,+Y,0),U,17)="C",$$LAB=1 D G:$D(RMPR29C) EXIT
26 . W !,"**** You are unable to EDIT this transaction....this is a LAB STOCK issue !!!",!
27 . S RMPR29C=1
28 S RMPRDA=+Y I $P(^RMPR(664.1,RMPRDA,0),U,17)="C" D AUT G:$D(RMPR29C) EXIT
29 S PNK=1 G DISP^RMPR29D
30CA ;CANCEL FORM 2529-3
31 ;CALLED FROM RMPR29T
32 ;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
33 K DIR S DIR(0)="Y"
34 S DIR("A")="Do you really want to Cancel the entire 2529-3"
35 S DIR("B")="NO" D ^DIR G:$D(DTOUT)!(X="^") EXIT
36 I +Y=0 G DISP^RMPR29D
37 L +^RMPR(664.1,RMPRDA):1 I '$T W !,$C(7),"ANOTHER USER IS EDITING THIS RECORD!" G EXIT
38 S DIE="^RMPR(664.1,",DA=RMPRDA
39 S DR="8///^S X=DT;32///@;28///@;30///@;19///@;20///@;S $P(^RMPR(664.1,DA,3),U)=DUZ;11"
40 D ^DIE L -^RMPR(664.1,RMPRDA)
41 I $D(DTOUT)!$D(Y) G EXIT
42 D DEL^RMPR29P(RMPRDA)
43 ;
44 ;THIS IS THE NEW CODE TO CANCEL A -3
45 ;DELETE ENTRIES FROM 660, POINTER FROM 664.1
46 ;DELETE ENTRIES FROM 664.3
47 ;CHECK FILE 664.2 FOR POINTERS TO FILE 664, IF ANY THEN
48 ;SEND E-MAIL TO PA'S SO THEY CAN CANCEL PO'S
49 ;DELETE WORK ORDER ENTRY IN 664.2
50 ;SET FLAG IN FILE 664.1 AS CANCELED AND UPDATE FIELDS.
51 ;
52 I RMPRDA="" W !!,$C(7),"SEE YOUR APPLICATION COORDINATOR!" G EXIT
53 N RMPRB,RMPRBA,RMPRBB,RMPRBC,RMPRBD,RMPRBE
54 S RMPRB=0,RMPRBA=""
55 F S RMPRB=$O(^RMPR(664.1,RMPRDA,2,RMPRB)) Q:RMPRB'>0 D
56 .;looping through items to get pointer to 2319 record
57 .S RMPRBA=$P(^RMPR(664.1,RMPRDA,2,RMPRB,0),U,5)
58 .Q:RMPRBA=""
59 .;remove techs hours date associated with 2319
60 .S RMPRBE=0
61 .F S RMPRBE=$O(^RMPR(664.3,"C",RMPRBA,RMPRBE)) Q:RMPRBE'>0 D
62 ..S DIK="^RMPR(664.3,",DA=RMPRBE D ^DIK K DIK,DA
63 .;update 2319
64 .S DIK="^RMPR(660,",DA=RMPRBA D ^DIK K DIK,DA
65 .;Get work order ien, and ien to 664
66 .S RMPR2DA=$P(^RMPR(664.1,RMPRDA,2,RMPRB,0),U,6)
67 .Q:'RMPR2DA
68 .S RMPRBC=0
69 .S RMPRBC=$O(^RMPR(664.2,RMPR2DA,1,RMPRBC)) Q:RMPRBC'>0
70 .S RMPRBD=$P(^RMPR(664.2,RMPR2DA,1,RMPRBC,0),U,11)
71 .Q:RMPRBD=""
72 .D CA21^RMPR29M(RMPRDA,RMPRBD)
73 ;now delete the work order
74 I '$G(RMPR2DA) W !!,$C(7),?5,"2529-3 Canceled" G EXIT
75 S DIK="^RMPR(664.2,",DA=RMPR2DA D ^DIK K DIK,DA
76 ;Update the 2529-3
77 S $P(^RMPR(664.1,RMPRDA,0),U,24)=""
78 S DIE="^RMPR(664.1,",DA=RMPRDA
79 S DR=".09///@;15///@;16///^S X=""CA""" D ^DIE
80 W !!,$C(7),?5,"2529-3 Canceled"
81 G EXIT
82 ;END
83RT ;RETURN FORM 2529-3 TO TECHNICIAN
84 ;CALLED FROM RMPR29T
85 ;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1.
86 K DIR S DIR(0)="Y"
87 S DIR("A")="Do you really want to return the 2529-3 to the Lab"
88 S DIR("B")="NO" D ^DIR G:$D(DTOUT)!(X="^") EXIT
89 I +Y=0 G DISP^RMPR29D
90 ;lock, edit
91 L +^RMPR(664.1,RMPRDA):1 I '$T W !,$C(7),"ANOTHER USER IS EDITING THIS RECORD!" G EXIT
92 S DIE="^RMPR(664.1,",DA=RMPRDA
93 S DR="10///^S X=DT;S $P(^RMPR(664.1,DA,7),U,3)=DUZ;11.5"
94 D ^DIE L -^RMPR(664.1,RMPRDA)
95 ;unlock
96 G:$D(DTOUT)!$D(Y) EXIT
97 K DR S DR="16///^S X=""R""" D ^DIE
98 W !!,$C(7),?5,"2529-3 Returned to Lab and Notification sent!!"
99 D RTM^RMPR29M
100EXIT ;REMOTE 2529-3 EXIT
101 ;CALLED FROM RMPR29T
102 ;VARIABLES REQUIRED - NONE
103 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
104 I $D(PDCA),$D(RMPRDA) D D ASM^RMPR29S
105 .S R=RMPRDA,RMPRDA=$O(PDCA(RMPRDA)),Y=RMPRDA
106 .I $G(RMPRDA)<1 S RMPRDA=$O(PREV(-RMPRDA))
107 .K PDCA(R),PREV(-R),R
108 I '$D(PDCA) K RMPRDA
109 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
110 K RR,RSTAT,RT,RTX,RU,RZ,RZP,XMSUB,XMTEXT,XMY,X,Y
111 Q
112AUT ;AUDIT 2529-3 REOPEN
113 ;REQUIRED VARIABLE: RMPRDA - ENTRY NUMBER IN FILE 664.1
114 ;CALLED FROM CMP+5 AND CMA+2, WHICH HAVE CHECKED AND FOUND RMPRDA IS
115 ;A VALID ENTRY NUMBER FOR A COMPLETED VAF 10-2529-3.
116 ;SETS THE VARIABLE RMPR29C EQUAL TO 1 IF USER DOES NOT WANT TO REOPEN
117 ;THE VAF 10-2529-3.
118 K RMPR29C,DIR S DIR(0)="Y"
119 S DIR("A")="This 2529-3 has been Completed. Would you like to re-open the 2529-3",DIR("B")="Yes"
120 D ^DIR
121 I $D(DIRUT)!($D(DTOUT))!(+Y=0) S RMPR29C=1 Q
122 D NOW^%DTC S (NX,X)=% K %
123 S DIC("P")="664.129DA",DA(1)=RMPRDA
124 S DIC="^RMPR(664.1,"_RMPRDA_",8,",DIC(0)="LZ"
125 S DLAYGO=664.1 D FILE^DICN K DLAYGO,DIC
126 L +^RMPR(664.1,RMPRDA):1 I '$T W !,$C(7),"ANOTHER USER IS EDITING THIS REOCRD!" G EXIT
127 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
128 S DIE="^RMPR(664.1,",DA=RMPRDA
129 S DR="22///@;23///@;16///^S X=""PC"""
130 D ^DIE L -^RMPR(664.1,RMPRDA)
131 Q
132LAB() ;check for lab stock issue, if it is, access not allowed.
133 S RZ=$O(^RMPR(664.1,+Y,2,0)) I $D(^RMPR(664.1,+Y,2,RZ,3)) Q 1
134 Q -1
Note: See TracBrowser for help on using the repository browser.