| 1 | RMPR5HQ1 ;HCIOFO/RVD - USAGE REPORT FOR HQ ; 04 AUG 00
|
|---|
| 2 | ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
|
|---|
| 3 | TASK ;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 | ;
|
|---|
| 14 | PROC ;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 | ;
|
|---|
| 26 | SEND(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 | ;
|
|---|
| 34 | SENDCONF(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 | ;
|
|---|
| 50 | NOADDR() ;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 | ;
|
|---|
| 58 | GETADDR() ;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 | ;
|
|---|
| 63 | ADDHQ ;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 | ;
|
|---|
| 69 | CLEAN ; Clean
|
|---|
| 70 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 71 | N RMPR,RMPRSITE
|
|---|
| 72 | K ^TMP($J)
|
|---|
| 73 | Q
|
|---|
