- 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 Feb 18, 2025@23:59:26 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
