source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5NU.m@ 771

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1RMPR5NU ;HIN/RVD-PROS INVENTORY SITE PARAMETERS UTILITY ;2/11/98
2 ;;3.0;PROSTHETICS;**33,38,52,61,132**;Feb 09, 1996;Build 13
3 ;
4 ;DBIA #10090 - file #4.
5 ; ODJ - patch 52 - 10/17/00 - if a 661.3 record is corrupted with a null
6 ; HCPC code then put message in report and
7 ; prevent routine from crashing.
8 ; (see nois NYH-0900-12030)
9 ;
10 ; RVD - patch #61 - used new files for inventory balance task job.
11 ;
12ADD ;add/edit inventory SITE PARAMETER
13 S DIC("A")="Select Prosthetics Site Name : "
14 S DIR("A")="Would you like to ACTIVATE this Item (Y/N) ",DIC=669.9,DIR(0)="Y"
15 S DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT G:$D(DTOUT) EXIT S DA=+Y
16 ;
17 ;I $P(^RMPR(661,RMDA,1),U,9)'=1 W !!,$C(7),"*** Item is inactive ***" D ^DIR S:Y=1 $P(^RMPR(661,RMDA,1),U,9)=1 G:Y=0 ADD
18 S DIE=DIC,DR="35" D ^DIE
19 G ADD
20 ;
21TASK ;entry point for task job to check balances.
22 K ^TMP($J)
23 S IO=0
24 S Y=DT D DD^%DT S RMRDAT=Y
25 S RMERR=$$MES^RMPRPIUD("")
26 ;a TMP($J global created for mail message.
27 Q:$G(RMERR)
28 D PROC S RMSUBI=5
29 I $D(^TMP($J,"RMX")) D BUILD
30MAIL D:$D(^XMB(3.8,"B","RMPR INVENTORY")) MES1,MES2
31 ;set Notification Date in file #669.9
32 S RS=0
33 F S RS=$O(^RMPR(669.9,RS)) Q:RS'>0 S $P(^RMPR(669.9,RS,"INV"),U,3)=DT
34 ;D WRI ;for printing to a designated inventory printer.
35 G EXIT
36 ;
37PROC ;process
38 F I=0:0 S I=$O(^TMP($J,"RMPRPIUD",I)) Q:I'>0 S J="" F S J=$O(^TMP($J,"RMPRPIUD",I,J)) Q:J="" F K=0:0 S K=$O(^TMP($J,"RMPRPIUD",I,J,K)) Q:K'>0 D
39 .F L=0:0 S L=$O(^TMP($J,"RMPRPIUD",I,J,K,"L",L)) Q:L'>0 D
40 ..S RMDATA=$G(^TMP($J,"RMPRPIUD",I,J,K,"L",L))
41 ..S RMREOR=$P(RMDATA,U,1)
42 ..S RMQUAN=$P(RMDATA,U,2) I RMQUAN="" S RMQUAN=0
43 ..I RMREOR>RMQUAN D
44 ...S RM11=$O(^RMPR(661.11,"ASHI",I,J,K,0))
45 ...S RMITEM="xxxx"
46 ...I RM11,$D(^RMPR(661.11,RM11,0)) Q:$P(^RMPR(661.11,RM11,0),U,9) S RMITEM=$P(^RMPR(661.11,RM11,0),U,3)
47 ...S RML="****"
48 ...I L,$D(^RMPR(661.5,L,0)) S RML=$P(^RMPR(661.5,L,0),U,1)
49 ...S ^TMP($J,"RMX",I,RML,RMITEM)=RMITEM_"^"_RMREOR_"^"_RMQUAN_"^"_J_"-"_K
50 ...I $D(^TMP($J,"RMPRPIUD",I,J,K,"M")) D
51 ....F RMI=0:0 S RMI=$O(^TMP($J,"RMPRPIUD",I,J,K,"M",RMI)) Q:RMI'>0 D
52 .....S RMLEFT=0
53 .....F RMJ=0:0 S RMJ=$O(^TMP($J,"RMPRPIUD",I,J,K,"M",RMI,RMJ)) Q:RMJ'>0 S RM41=^TMP($J,"RMPRPIUD",I,J,K,"M",RMI,RMJ) D
54 ......S RMORD=$P(RM41,U,1)
55 ......S RMDATO=$P(RM41,U,2),RMRECV=$P(RM41,U,3),RMWDS=""
56 ......S:RMRECV RMWDS=" ...received to-date: "_RMRECV
57 ......;S RMLEF=RMORD-RMREC
58 ......;I $G(RMLEF) S RMLEFT=RMLEFT+RMLEF
59 ......I $G(RMORD) S ^TMP($J,"RMX",I,RML,RMITEM,"M",RMJ)=" **** Quantity = "_RMORD_" has been ordered for item..."_RMITEM_" on "_RMDATO_RMWDS
60 ;
61 Q
62MES1 ;
63 S XMY("G.RMPR INVENTORY")="",XMDUZ=.5,XMTEXT="RMX("
64 S XMSUB="PROSTHETICS INVENTORY MESSAGE"
65 S RMX(1)="Run Date: "_RMRDAT
66 S RMX(2)="This is a notification from the Prosthetics Department........"
67 S RMX(3)=""
68 S RMX(4)="The current balance for the following item(s) is/are below the reorder level:"
69 S RMX(5)="[Site] [Location] [Item] [HCPCS] [Reorder Lvl] [Bal] "
70 Q
71MES2 ;
72 S RMX(RMSUBI+2)=""
73 S RMX(RMSUBI+3)=""
74 S RMX(RMSUBI+4)="Thank You!!!"
75 S RMX(RMSUBI+5)=""
76 S RMX(RMSUBI+6)="PROSTHETICS DEPARTMENT"
77 D ^XMD
78 Q
79 ;
80BUILD S I=""
81 F S I=$O(^TMP($J,"RMX",I)) Q:I="" S J="" F S J=$O(^TMP($J,"RMX",I,J)) Q:J="" S K="" F S K=$O(^TMP($J,"RMX",I,J,K)) Q:K="" S RM0=^TMP($J,"RMX",I,J,K) D
82 .S RML=$P(RM0,U,2),RMB=$P(RM0,U,3),RMSTA=I,RMLO=J,RMITEM=K,RMHCPC=$P(RM0,U,4)_" "
83 .S RMITEM=RMITEM_" "
84 .S RMSUBI=RMSUBI+1,RMLO=RMLO_" "
85 .S RMX(RMSUBI)=$E($P(^DIC(4,RMSTA,0),U,1),1,6)_" "_$E(RMLO,1,16)_" "_$E(RMITEM,1,28)_" "_$E(RMHCPC,1,9)_" "_$J(RML,5)_" "_$J(RMB,5)
86 .;S RMXI(RMSUBI)=RMX(RMSUBI)_"^"_I_"^"_J_"^"_K
87 .I $D(^TMP($J,"RMX",I,J,K,"M")) D
88 ..S RMJ=0
89 ..F S RMJ=$O(^TMP($J,"RMX",I,J,K,"M",RMJ)) Q:RMJ="" D
90 ...S RMSUBI=RMSUBI+1,RMX(RMSUBI)=^TMP($J,"RMX",I,J,K,"M",RMJ)
91 Q
92 ;
93WRI ;PRINT NOTIFICATION LETTER IN SUPPLY PRINTER. This functionality is not included with this released.
94 ;S RMDEV=$P(^RMPR(669.9,RS,"INV"),U,1)
95 ;S RMIOS=IO,IO=$P(^%ZIS(1,RMDEV,0),U,2)
96 ;D NOW^%DTC
97 ;O IO U IO W !,"Run Date: ",RMRDAT,!!,"This is a notification from the Prosthetics Department..."
98 ;W !!,"The current balance for the following item(s) is/are below the reorder level:"
99 ;W !,"[Location] [Item] [HCPCS] [Reorder Level] [Current Balance]"
100 ;F I=0:0 S I=$O(RMXI(I)) Q:I'>0 D
101 ;.S RMLO=$P(RMXI(I),U,2),RMI=$P(RMXI(I),U,3)
102 ;.W !,$P(RMXI(I),U,1)
103 ;.S $P(^RMPR(661.3,RMLO,1,RMI,0),U,7)=%
104 ;W !!!,"Thank You!!!!!"
105 ;W !!,"PROSTHETICS DEPARTMENT"
106 ;S $P(^RMPR(669.9,RS,"INV"),U,3)=DT
107 ;D ^%ZISC S IO=RMIOS O IO U IO
108 ;K RMB,RMD,RMI,RML,RMDO,RMDATI,RMLOCI,RMXI,I,J,XMTEXT,RMGROUP,RMHCPC
109 ;Q
110 ;
111EXIT ;MAIN EXIT POINT
112 N RMPRSITE,RMPR D KILL^XUSCLEAN
113 K ^TMP($J)
114 Q
Note: See TracBrowser for help on using the repository browser.