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@domain.ext"""
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR5HQ1 2363 printed Dec 13, 2024@02:32:57 Page 2
RMPR5HQ1 ;HCIOFO/RVD - USAGE REPORT FOR HQ ; 04 AUG 00
+1 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
TASK ;task the option to create a mail message to PSAS HQ.
+1 ;PIP data will come from a ^TMP( global.
+2 ;variables rmprpip1 and rmprpip2 are date range from the server.
+3 if RMPRPIP2<RMPRPIP1
QUIT
+4 SET X1=RMPRPIP2
SET X2=RMPRPIP1
+5 DO ^%DTC
SET RMCALDAY=X+1
+6 DO NATION^RMPR5HQ5
+7 DO PROC
+8 DO CLEAN
+9 QUIT
+10 ;
PROC ;process the PIP reports and e-mail to NPPD DATABASE
+1 SET RMQMAIL=$$GETADDR()
+2 SET RMQSUBJ="Prosthetics PIP Extract"
+3 SET Y=RMPRPIP1
DO DD^%DT
SET RMBDT=Y
+4 SET Y=RMPRPIP2
DO DD^%DT
SET RMEDT=Y
+5 SET RD=$ORDER(^TMP($JOB,"RMPR5A",0))
+6 DO SEND(RMQMAIL,RMQSUBJ)
if $DATA(RQUIT)
GOTO CLEAN
+7 ;S RMQMES=XMZ
+8 DO SENDCONF(RMQSUBJ,RMBDT,RMEDT)
if $DATA(RQUIT)
GOTO CLEAN
+9 FOR RI=0:0
SET RI=$ORDER(^RMPR(669.9,RI))
if RI'>0
QUIT
SET $PIECE(^RMPR(669.9,RI,"INV"),U,5)=DT
+10 QUIT
+11 ;
SEND(RMQMAIL,RMQSUBJ) ; Send mail from ^TMP($J,"RMPR5A")
+1 ; Send mail to defined recipient(s) in RMQMAIL
+2 SET XMSUB=RMQSUBJ_" from "_$PIECE($$SITE^VASITE,U,2)
SET XMDUZ=.5
+3 SET X=RMQMAIL
SET XMY(X)=""
+4 SET XMTEXT="^TMP($J,""RMPR5A"","
+5 DO ^XMD
+6 QUIT
+7 ;
SENDCONF(RMQSUBJ,RMBDT,RMEDT) ; Send Confirmation to User
+1 ;
+2 KILL ^TMP($JOB,"CONFIRM")
+3 SET XMSUB=RMQSUBJ
SET XMDUZ=.5
SET XMY("G.RMPR SERVER")=""
+4 SET X(1)="The Prosthetics PIP Inventory Data was transmitted to PSAS HQ today."
+5 SET X(2)="The dates used for Days On-Hand, and Days Average Usage Rate calculations"
+6 SET X(3)="were "_RMBDT_" to "_RMEDT_"."
+7 SET X(4)=""
+8 SET X(5)="The server was activated by "_$PIECE(XMFROM,"@",1)
+9 SET Y=""
+10 FOR
SET Y=$ORDER(X(Y))
if Y=""
QUIT
Begin DoDot:1
+11 SET ^TMP($JOB,"CONFIRM",Y)=X(Y)
End DoDot:1
+12 SET XMTEXT="^TMP($J,""CONFIRM"","
+13 DO ^XMD
+14 QUIT
+15 ;
NOADDR() ;print a No Address message in the screen.
+1 WRITE !!,"No HQ mail address is defined in your PROSTHETICS SITE"
+2 WRITE !," PARAMETERS file for the PIP report. The PIP report"
+3 WRITE !," will not be run. Please contact your system administrator"
+4 WRITE !," or enter a NOIS in Forum for the NVS Team.",!!
+5 SET RQUIT="^"
+6 QUIT
+7 ;
GETADDR() ;get PSAS HQ e-mail address from #669.9
+1 NEW RMA,RI
+2 FOR RI=0:0
SET RI=$ORDER(^RMPR(669.9,RI))
if RI'>0
QUIT
SET RMA=$PIECE($GET(^RMPR(669.9,RI,"INV")),U,4)
if RMA'=""
QUIT
+3 QUIT RMA
+4 ;
ADDHQ ;update HQ MAIL ADDRESS & VISN in file 669.9
+1 SET DIE="^RMPR(669.9,"
SET DR="38////^S X=""VHACOPSASPIPReport@domain.ext"""
+2 FOR RI=0:0
SET RI=$ORDER(^RMPR(669.9,RI))
if RI'>0
QUIT
SET DA=RI
DO ^DIE
+3 KILL RI,DIE,DA,DR
+4 QUIT
+5 ;
CLEAN ; Clean
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 NEW RMPR,RMPRSITE
+3 KILL ^TMP($JOB)
+4 QUIT
