source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29M.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1RMPR29M ;PHX/JLT-E/MAIL FOR 2529-3 ACTION [4/14/95]
2 ;;3.0;PROSTHETICS;;Feb 09, 1996
3CA21(RDA,PDA) ;CANCEL 2421 MESSAGE FOR ^RMPR(664.1,RDA) AND ^RMPR(664,PDA)
4 ;CALLED FROM RMPR29C Cancel a 2529-3
5 ;VARIABLES REQUIRED: RDA- ENTRY NUMBER IN FILE 664.1
6 ; PDA - ENTRY NUMBER IN FILE 664
7 ; RMPRWO - WORK ORDER
8 ; SET: XMTEXT - TEXT FOR MAIL MESSAGE.
9 Q:'$D(^RMPR(664.1,RDA,0))
10 N RMPRWO,RMPRREF
11 S RMPRWO=$P(^RMPR(664.1,RDA,0),U,13)
12 ;rmprref is the reference number ot ifcap
13 S RMPRREF=$P($G(^RMPR(664,PDA,0)),U,7)
14 ;quit if the purchase has been cancelled or closed-out already
15 I $D(^RMPR(664,PDA,0)),($P(^(0),8,0)!($P(^(0),U,5))) Q
16 ;send message
17 K XMY
18 I RMPRREF'="" S XMSUB="Request to Cancel Prosthetics Purchase "_RMPRREF,RTX(1)="Work Order # "_RMPRWO_" has been Canceled.",RTX(2)="Please take action on "_RMPRREF_"."
19 E S XMSUB="2421 Request for Work Order # "_RMPRWO_" has been Canceled",RTX(1)="2421 Request for Work Order # "_RMPRWO_" has been Canceled"
20 S RTX(3)="BY: "_$$EMP^RMPR31U(DUZ)
21 ;get cancellation remarks from the 2529-3
22 F RT=0:0 S RT=$O(^RMPR(664.1,RDA,4,RT)) Q:RT'>0 I $D(^(RT,0)) S RTX(RT+3)=^(0)
23 ;
24 D ADM,SUP
25 I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
26 Q
27 ;
28IRQ ;SEND 2421 REQUEST NOTIFICATION
29 Q:'$D(^RMPR(664.1,RMPRDA,0)) N RMPRWO S RMPRWO=$P(^RMPR(664.1,RMPRDA,0),U,13) K XMY
30 S XMSUB="2421 Request for Work Order # "_RMPRWO_" has been initiated",RTX(1)="2421 Request for Work Order # "_RMPRWO_" has been intiated"
31 S RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
32 D ADM,SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
33 Q
34ADM ;MAKE HOLDERS OF 'RMPR LAB ADMIN' KEY RECEIVER OF MESSAGE.
35 F RT=0:0 S RT=$O(^XUSEC("RMPR LAB ADMIN",RT)) Q:RT'>0 S XMY(RT)=""
36 Q
37SUP ;MAKE HOLDERS OF 'RMPR LAB SUPERVISOR' KEY RECEIVERS OF MESSAGE ALSO.
38 F RT=0:0 S RT=$O(^XUSEC("RMPR LAB SUPERVISOR",RT)) Q:RT'>0 S XMY(RT)=""
39 Q
40RTM ;RETURN 2529-3 TO LAB
41 ;CALLED BY RMPR29C
42 ;VARIABLES REQUIRED - RMPRDA ENTRY NUMBER IN FIRL 664.1
43 N PEMP,RMPRWO S PEMP=$P(^RMPR(664.1,RMPRDA,0),U,16),RMPRWO=$P(^(0),U,13) I +PEMP>0 S XMY(PEMP)=""
44 F RI=0:0 S RI=$O(^RMPR(664.1,RMPRDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S RDA=^(0),RA=$P(RDA,U,5) D
45 .F DA=0:0 S DA=$O(^RMPR(664.3,"C",RA,DA)) Q:DA'>0 I $D(^RMPR(664.3,DA)) F RU=0:0 S RU=$O(^RMPR(664.3,DA,1,RU)) Q:RU'>0 I $D(^(RU,0)) S PEMP=$P(^(0),U) I PEMP>0 S XMY(PEMP)=""
46 S XMSUB="Work Order # "_RMPRWO_" Returned to Lab",RTX(1)=XMSUB,RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
47 F RR=0:0 S RR=$O(^RMPR(664.1,RMPRDA,6,RR)) Q:RR'>0 I $D(^(RR,0)) S RTX(RR+2)=^(0)
48 D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
49 Q
50CA0(RDA,PDA) ;CANCEL 2421 OBLIGATION
51 Q:'$D(^RMPR(664.1,RDA,0)) N RMPRWO,RMPRREF S RMPRWO=$P(^RMPR(664.1,RDA,0),U,13),RMPRREF=$P($G(^RMPR(664,PDA,0)),U,7) K XMY
52 S XMSUB="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Canceled",RTX(1)="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Canceled"
53 S RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
54 S PEMP=$P(^RMPR(664.1,RDA,0),U,16) I +PEMP>0 S XMY(PEMP)=""
55 F RI=0:0 S RI=$O(^RMPR(664.1,RDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S RDA=^(0),RA=$P(RDA,U,5) D
56 .F DA=0:0 S DA=$O(^RMPR(664.3,"C",RA,DA)) Q:DA'>0 I $D(^RMPR(664.3,DA)) F RU=0:0 S RU=$O(^RMPR(664.3,DA,1,RU)) Q:RU'>0 I $D(^(RU,0)) S PEMP=$P(^(0),U) I PEMP>0 S XMY(PEMP)=""
57 D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
58 Q
59DA0(RDA,PDA) ;DELIVER 2421
60 Q:'$D(^RMPR(664.1,RDA,0)) N RMPRWO,RMPRREF S RMPRWO=$P(^RMPR(664.1,RDA,0),U,13),RMPRREF=$P($G(^RMPR(664,PDA,0)),U,7) K XMY
61 S XMSUB="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Delivered"
62 S RTX(1)="The 2421 Request "_RMPRREF_"has been closed out,"
63 S RTX(2)="by "_$$EMP^RMPR31U(DUZ)_"."
64 S RTX(3)=" "
65 S RTX(4)="This is associated with Work Order # "_RMPRWO_","
66 S RTX(5)="assigned to technician "_$P(^VA(200,$P(^RMPR(664.1,RDA,0),U,16),0),U,1)_"."
67 S PEMP=$P(^RMPR(664.1,RDA,0),U,16) I +PEMP>0 S XMY(PEMP)=""
68 F RI=0:0 S RI=$O(^RMPR(664.1,RDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S RDA=^(0),RA=$P(RDA,U,5) D
69 .F DA=0:0 S DA=$O(^RMPR(664.3,"C",RA,DA)) Q:DA'>0 I $D(^RMPR(664.3,DA)) F RU=0:0 S RU=$O(^RMPR(664.3,DA,1,RU)) Q:RU'>0 I $D(^(RU,0)) S PEMP=$P(^(0),U) I PEMP>0 S XMY(PEMP)=""
70 D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
71 Q
72DEL(PDA) ;DELETED 2421 REQUEST
73 Q:('$D(^RMPR(664,PDA,0))) K XMY N RMPRWO S RMPRWO=$P($G(^RMPR(664.2,+$P(^(0),U,15),0)),U) I $P(^RMPR(664,PDA,0),U,16) S XMY($P(^(0),U,16))=""
74 S DIE="^RMPR(664,",DA=RMPRA,DR="24" D ^DIE S XMSUB="2421 Request for Work Order # "_RMPRWO_" Has been Deleted",RTX(1)=XMSUB,RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
75 F RW=0:0 S RW=$O(^RMPR(664,PDA,4,RW)) Q:RW'>0 I $D(^(RW,0)) S RTX(RW+3)=^(0)
76 D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
77 Q
78SLK ;SETUP DIC("S") FOR LABOR HOURS
79 ;see internal notes
80 ;CALLED FROM RMPR29B
81 ;VARIABLES REQUIRED: + Y
82 S DIC("S")="I $P(^RMPR(664.3,+Y,0),U,2)=DA660",DIC("W")="F ZI=0:0 S ZI=$O(^RMPR(664.3,+Y,1,ZI)) Q:+ZI'>0 I $D(^(ZI,0)) W ?40,$$EMP^RMPR31U($P(^(0),U)) I $O(^RMPR(664.3,+Y,1,ZI)) W !",DLAYGO=664.3,DIC="^RMPR(664.3,",DIC(0)="QML" Q
83 Q
84PAP ;PURCHASE APPROVAL
85 Q
86 ;N RMPR90I
87 ;D DIV4^RMPRSIT
88 ;I '$D(^XUSEC("RMPRSUPERVISOR",DUZ)) Q
89 ;S CNT=0 S RMPR90I=0 F S RMPR90I=$O(^RMPR(664,"AP",RMPR("STA"),RMPR90I)) Q:RMPR90I'>0 S CNT=CNT+1
90 ;I +CNT W !!,?5,$C(7),"There "_$S(CNT>1:"are ",1:"is ")_CNT_" Purchase Request(s) Pending Approval"
91 ;Q
Note: See TracBrowser for help on using the repository browser.