74 lines
2.2 KiB
Mathematica
74 lines
2.2 KiB
Mathematica
RMPR5HQ1 ;HCIOFO/RVD - USAGE REPORT FOR HQ ; 04 AUG 00
|
|
;;3.0;PROSTHETICS;**51**;Feb 09, 1996
|
|
TASK ;task the option to create a mail message to PSAS HQ.
|
|
;PIP data will come from a ^TMP( global.
|
|
;variables rmprpip1 and rmprpip2 are date range from the server.
|
|
Q:RMPRPIP2<RMPRPIP1
|
|
S X1=RMPRPIP2,X2=RMPRPIP1
|
|
D ^%DTC S RMCALDAY=X+1
|
|
D NATION^RMPR5HQ5
|
|
D PROC
|
|
D CLEAN
|
|
Q
|
|
;
|
|
PROC ;process the PIP reports and e-mail to NPPD DATABASE
|
|
S RMQMAIL=$$GETADDR()
|
|
S RMQSUBJ="Prosthetics PIP Extract"
|
|
S Y=RMPRPIP1 D DD^%DT S RMBDT=Y
|
|
S Y=RMPRPIP2 D DD^%DT S RMEDT=Y
|
|
S RD=$O(^TMP($J,"RMPR5A",0))
|
|
D SEND(RMQMAIL,RMQSUBJ) G:$D(RQUIT) CLEAN
|
|
;S RMQMES=XMZ
|
|
D SENDCONF(RMQSUBJ,RMBDT,RMEDT) G:$D(RQUIT) CLEAN
|
|
F RI=0:0 S RI=$O(^RMPR(669.9,RI)) Q:RI'>0 S $P(^RMPR(669.9,RI,"INV"),U,5)=DT
|
|
Q
|
|
;
|
|
SEND(RMQMAIL,RMQSUBJ) ; Send mail from ^TMP($J,"RMPR5A")
|
|
; Send mail to defined recipient(s) in RMQMAIL
|
|
S XMSUB=RMQSUBJ_" from "_$P($$SITE^VASITE,U,2),XMDUZ=.5
|
|
S X=RMQMAIL,XMY(X)=""
|
|
S XMTEXT="^TMP($J,""RMPR5A"","
|
|
D ^XMD
|
|
Q
|
|
;
|
|
SENDCONF(RMQSUBJ,RMBDT,RMEDT) ; Send Confirmation to User
|
|
;
|
|
K ^TMP($J,"CONFIRM")
|
|
S XMSUB=RMQSUBJ,XMDUZ=.5,XMY("G.RMPR SERVER")=""
|
|
S X(1)="The Prosthetics PIP Inventory Data was transmitted to PSAS HQ today."
|
|
S X(2)="The dates used for Days On-Hand, and Days Average Usage Rate calculations"
|
|
S X(3)="were "_RMBDT_" to "_RMEDT_"."
|
|
S X(4)=""
|
|
S X(5)="The server was activated by "_$P(XMFROM,"@",1)
|
|
S Y=""
|
|
F S Y=$O(X(Y)) Q:Y="" D
|
|
.S ^TMP($J,"CONFIRM",Y)=X(Y)
|
|
S XMTEXT="^TMP($J,""CONFIRM"","
|
|
D ^XMD
|
|
Q
|
|
;
|
|
NOADDR() ;print a No Address message in the screen.
|
|
W !!,"No HQ mail address is defined in your PROSTHETICS SITE"
|
|
W !," PARAMETERS file for the PIP report. The PIP report"
|
|
W !," will not be run. Please contact your system administrator"
|
|
W !," or enter a NOIS in Forum for the NVS Team.",!!
|
|
S RQUIT="^"
|
|
Q
|
|
;
|
|
GETADDR() ;get PSAS HQ e-mail address from #669.9
|
|
N RMA,RI
|
|
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'=""
|
|
Q RMA
|
|
;
|
|
ADDHQ ;update HQ MAIL ADDRESS & VISN in file 669.9
|
|
S DIE="^RMPR(669.9,",DR="38////^S X=""VHACOPSASPIPReport@med.va.gov"""
|
|
F RI=0:0 S RI=$O(^RMPR(669.9,RI)) Q:RI'>0 S DA=RI D ^DIE
|
|
K RI,DIE,DA,DR
|
|
Q
|
|
;
|
|
CLEAN ; Clean
|
|
I $D(ZTQUEUED) S ZTREQ="@" Q
|
|
N RMPR,RMPRSITE
|
|
K ^TMP($J)
|
|
Q
|