source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQ1.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1RMPR5HQ1 ;HCIOFO/RVD - USAGE REPORT FOR HQ ; 04 AUG 00
2 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
3TASK ;task the option to create a mail message to PSAS HQ.
4 ;PIP data will come from a ^TMP( global.
5 ;variables rmprpip1 and rmprpip2 are date range from the server.
6 Q:RMPRPIP2<RMPRPIP1
7 S X1=RMPRPIP2,X2=RMPRPIP1
8 D ^%DTC S RMCALDAY=X+1
9 D NATION^RMPR5HQ5
10 D PROC
11 D CLEAN
12 Q
13 ;
14PROC ;process the PIP reports and e-mail to NPPD DATABASE
15 S RMQMAIL=$$GETADDR()
16 S RMQSUBJ="Prosthetics PIP Extract"
17 S Y=RMPRPIP1 D DD^%DT S RMBDT=Y
18 S Y=RMPRPIP2 D DD^%DT S RMEDT=Y
19 S RD=$O(^TMP($J,"RMPR5A",0))
20 D SEND(RMQMAIL,RMQSUBJ) G:$D(RQUIT) CLEAN
21 ;S RMQMES=XMZ
22 D SENDCONF(RMQSUBJ,RMBDT,RMEDT) G:$D(RQUIT) CLEAN
23 F RI=0:0 S RI=$O(^RMPR(669.9,RI)) Q:RI'>0 S $P(^RMPR(669.9,RI,"INV"),U,5)=DT
24 Q
25 ;
26SEND(RMQMAIL,RMQSUBJ) ; Send mail from ^TMP($J,"RMPR5A")
27 ; Send mail to defined recipient(s) in RMQMAIL
28 S XMSUB=RMQSUBJ_" from "_$P($$SITE^VASITE,U,2),XMDUZ=.5
29 S X=RMQMAIL,XMY(X)=""
30 S XMTEXT="^TMP($J,""RMPR5A"","
31 D ^XMD
32 Q
33 ;
34SENDCONF(RMQSUBJ,RMBDT,RMEDT) ; Send Confirmation to User
35 ;
36 K ^TMP($J,"CONFIRM")
37 S XMSUB=RMQSUBJ,XMDUZ=.5,XMY("G.RMPR SERVER")=""
38 S X(1)="The Prosthetics PIP Inventory Data was transmitted to PSAS HQ today."
39 S X(2)="The dates used for Days On-Hand, and Days Average Usage Rate calculations"
40 S X(3)="were "_RMBDT_" to "_RMEDT_"."
41 S X(4)=""
42 S X(5)="The server was activated by "_$P(XMFROM,"@",1)
43 S Y=""
44 F S Y=$O(X(Y)) Q:Y="" D
45 .S ^TMP($J,"CONFIRM",Y)=X(Y)
46 S XMTEXT="^TMP($J,""CONFIRM"","
47 D ^XMD
48 Q
49 ;
50NOADDR() ;print a No Address message in the screen.
51 W !!,"No HQ mail address is defined in your PROSTHETICS SITE"
52 W !," PARAMETERS file for the PIP report. The PIP report"
53 W !," will not be run. Please contact your system administrator"
54 W !," or enter a NOIS in Forum for the NVS Team.",!!
55 S RQUIT="^"
56 Q
57 ;
58GETADDR() ;get PSAS HQ e-mail address from #669.9
59 N RMA,RI
60 F RI=0:0 S RI=$O(^RMPR(669.9,RI)) Q:RI'>0 S RMA=$P($G(^RMPR(669.9,RI,"INV")),U,4) Q:RMA'=""
61 Q RMA
62 ;
63ADDHQ ;update HQ MAIL ADDRESS & VISN in file 669.9
64 S DIE="^RMPR(669.9,",DR="38////^S X=""VHACOPSASPIPReport@med.va.gov"""
65 F RI=0:0 S RI=$O(^RMPR(669.9,RI)) Q:RI'>0 S DA=RI D ^DIE
66 K RI,DIE,DA,DR
67 Q
68 ;
69CLEAN ; Clean
70 I $D(ZTQUEUED) S ZTREQ="@" Q
71 N RMPR,RMPRSITE
72 K ^TMP($J)
73 Q
Note: See TracBrowser for help on using the repository browser.