RMPRESRV ;PHX/HNC - SERVER ROUTINE FOR NATIONAL DATA EXTRACT ; 1/19/2005
;;3.0;PROSTHETICS;**12,18,24,51,59,103,125**;Feb 09, 1996;Build 21
;Per VHA Directive 10-93-142, this routine should not be modified.
;
;DBIA # 10072 - for routine REMSBMSG^XMA1C
;
;HCPCS SERVER - patch 103, HNC 1/19/2005
;
;modified to include the PIP extract 9/28/00
X XMREC D
.;disability codes
.I XMRG["DS1" S RMPRDS1=$P(XMRG,"*",2)
.I XMRG["DS2" S RMPRDS2=$P(XMRG,"*",4)
.;new and repair worksheets
.I XMRG["DT1" S RMPRDT1=$P(XMRG,"*",2)
.I XMRG["DT2" S RMPRDT2=$P(XMRG,"*",4)
.;suspense delayed order report
.I XMRG["DOR1" S RMPRDOR1=$P(XMRG,"*",2)
.I XMRG["DOR1" S RMPRDORS=$P(XMRG,"*",3)
.I XMRG["DOR1" S RMPRDORW=$P(XMRG,"*",4)
.I XMRG["DOR1" D A1^RMPR9DO("00","99","ALL",RMPRDORS,RMPRDOR1,RMPRDORW) S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C Q
;new items to file 661.1
I XMRG="ITEM SERVER 661.1" G EN^RMPRET
;retransmit a date for patient notification patch 125
I XMRG="RETRANS NOTIFICATION INFO" D G IN1^RMPRDVN
. X XMREC S BDATE=$P(XMRG,"*",2)
. ;Send message to local VAMC staff and to PCM VACO Staff on Outlook
. S XMDUZ=.5
. S XMY("G.RMPR SERVER")=""
. S XMY("VHACOPSASPIPReport@domain.ext")=""
. S XMSUB="Retransmit Patient Notification Data "_$P($$SITE^VASITE,U,2)
. S RMPRMSG(1)="The National PSAS Server has been activated today by Prosthetics HQ."
. S RMPRMSG(2)="Please note data for Patient Notification was not received"
. S RMPRMSG(3)=""
. S RMPRMSG(4)="This was activated by "_$P(XMFROM,"@",1)
. S RMPRMSG(5)=""
. S XMTEXT="RMPRMSG("
. D ^XMD
. ;call routine to gather data
. Q
;pip EXCEL extract
I $P(XMRG,"*",1)="PIP ROLL-UP" S RMPRPIP1=$P(XMRG,"*",2),RMPRPIP2=$P(XMRG,"*",3) G ^RMPR5HQ1
;pip REPORT extract
I $P(XMRG,"*",1)="PIP REPORT" S RMPRPIP1=$P(XMRG,"*",2),RMPRPIP2=$P(XMRG,"*",3),RMPRDET=$P(XMRG,"*",4) G ^RMPR5HQA
;open obligations
I XMRG="PR2" G PR2^RMPREXT
I $D(RMPRDS1)&($D(RMPRDS2)) D EN^RMPREXDS(RMPRDS1,RMPRDS2) G EXIT
I '$D(RMPRDT1)!('$D(RMPRDT2)) G EXIT
;dates for message subject
S Y=RMPRDT1 D DD^%DT S RMPRDAT1=Y
S Y=RMPRDT2 D DD^%DT S RMPRDAT2=Y
;send message to group so they know the server was activated
S XMDUZ=.5
S XMY("G.RMPR SERVER")=""
S XMSUB="Prosthetics Data Extract "_RMPRDAT1_" to "_RMPRDAT2
S RMPRMSG(1)="The National Data Server has been activated today by Prosthetics HQ."
S RMPRMSG(2)="Data has been collected for the date range "_RMPRDAT1_" to "_RMPRDAT2_"."
S RMPRMSG(3)=""
S RMPRMSG(4)="This was activated by "_$P(XMFROM,"@",1)
S RMPRMSG(5)=""
S XMTEXT="RMPRMSG("
D ^XMD
;refresh amis codes in file 660
D ^RMPREXR
;gather and send the raw data
;add additional extract here if needed
D EN1^RMPREXT
EXIT ;common exit point
S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
K RMPRDAT1,RMPRDAT2,RMPRDT1,XMRG,XMSUB
K RMPRDET,RMPRDOR1,RMPRDORS,RMPRDORW,RMPRDS1,RMPRDS2,RMPRDT2,RMPRMSG
K RMPRPIP1,RMPRPIP2,XMDUZ,XMFROM,XMREC,XMSER,XMTEXT,XMY,XMZ,XQMSG,XQSOP,Y
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRESRV 3042 printed Apr 09, 2024@21:36:07 Page 2
RMPRESRV ;PHX/HNC - SERVER ROUTINE FOR NATIONAL DATA EXTRACT ; 1/19/2005
+1 ;;3.0;PROSTHETICS;**12,18,24,51,59,103,125**;Feb 09, 1996;Build 21
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;DBIA # 10072 - for routine REMSBMSG^XMA1C
+5 ;
+6 ;HCPCS SERVER - patch 103, HNC 1/19/2005
+7 ;
+8 ;modified to include the PIP extract 9/28/00
+9 XECUTE XMREC
Begin DoDot:1
+10 ;disability codes
+11 IF XMRG["DS1"
SET RMPRDS1=$PIECE(XMRG,"*",2)
+12 IF XMRG["DS2"
SET RMPRDS2=$PIECE(XMRG,"*",4)
+13 ;new and repair worksheets
+14 IF XMRG["DT1"
SET RMPRDT1=$PIECE(XMRG,"*",2)
+15 IF XMRG["DT2"
SET RMPRDT2=$PIECE(XMRG,"*",4)
+16 ;suspense delayed order report
+17 IF XMRG["DOR1"
SET RMPRDOR1=$PIECE(XMRG,"*",2)
+18 IF XMRG["DOR1"
SET RMPRDORS=$PIECE(XMRG,"*",3)
+19 IF XMRG["DOR1"
SET RMPRDORW=$PIECE(XMRG,"*",4)
+20 IF XMRG["DOR1"
DO A1^RMPR9DO("00","99","ALL",RMPRDORS,RMPRDOR1,RMPRDORW)
SET XMSER="S."_XQSOP
SET XMZ=XQMSG
DO REMSBMSG^XMA1C
QUIT
End DoDot:1
+21 ;new items to file 661.1
+22 IF XMRG="ITEM SERVER 661.1"
GOTO EN^RMPRET
+23 ;retransmit a date for patient notification patch 125
+24 IF XMRG="RETRANS NOTIFICATION INFO"
Begin DoDot:1
+25 XECUTE XMREC
SET BDATE=$PIECE(XMRG,"*",2)
+26 ;Send message to local VAMC staff and to PCM VACO Staff on Outlook
+27 SET XMDUZ=.5
+28 SET XMY("G.RMPR SERVER")=""
+29 SET XMY("VHACOPSASPIPReport@domain.ext")=""
+30 SET XMSUB="Retransmit Patient Notification Data "_$PIECE($$SITE^VASITE,U,2)
+31 SET RMPRMSG(1)="The National PSAS Server has been activated today by Prosthetics HQ."
+32 SET RMPRMSG(2)="Please note data for Patient Notification was not received"
+33 SET RMPRMSG(3)=""
+34 SET RMPRMSG(4)="This was activated by "_$PIECE(XMFROM,"@",1)
+35 SET RMPRMSG(5)=""
+36 SET XMTEXT="RMPRMSG("
+37 DO ^XMD
+38 ;call routine to gather data
+39 QUIT
End DoDot:1
GOTO IN1^RMPRDVN
+40 ;pip EXCEL extract
+41 IF $PIECE(XMRG,"*",1)="PIP ROLL-UP"
SET RMPRPIP1=$PIECE(XMRG,"*",2)
SET RMPRPIP2=$PIECE(XMRG,"*",3)
GOTO ^RMPR5HQ1
+42 ;pip REPORT extract
+43 IF $PIECE(XMRG,"*",1)="PIP REPORT"
SET RMPRPIP1=$PIECE(XMRG,"*",2)
SET RMPRPIP2=$PIECE(XMRG,"*",3)
SET RMPRDET=$PIECE(XMRG,"*",4)
GOTO ^RMPR5HQA
+44 ;open obligations
+45 IF XMRG="PR2"
GOTO PR2^RMPREXT
+46 IF $DATA(RMPRDS1)&($DATA(RMPRDS2))
DO EN^RMPREXDS(RMPRDS1,RMPRDS2)
GOTO EXIT
+47 IF '$DATA(RMPRDT1)!('$DATA(RMPRDT2))
GOTO EXIT
+48 ;dates for message subject
+49 SET Y=RMPRDT1
DO DD^%DT
SET RMPRDAT1=Y
+50 SET Y=RMPRDT2
DO DD^%DT
SET RMPRDAT2=Y
+51 ;send message to group so they know the server was activated
+52 SET XMDUZ=.5
+53 SET XMY("G.RMPR SERVER")=""
+54 SET XMSUB="Prosthetics Data Extract "_RMPRDAT1_" to "_RMPRDAT2
+55 SET RMPRMSG(1)="The National Data Server has been activated today by Prosthetics HQ."
+56 SET RMPRMSG(2)="Data has been collected for the date range "_RMPRDAT1_" to "_RMPRDAT2_"."
+57 SET RMPRMSG(3)=""
+58 SET RMPRMSG(4)="This was activated by "_$PIECE(XMFROM,"@",1)
+59 SET RMPRMSG(5)=""
+60 SET XMTEXT="RMPRMSG("
+61 DO ^XMD
+62 ;refresh amis codes in file 660
+63 DO ^RMPREXR
+64 ;gather and send the raw data
+65 ;add additional extract here if needed
+66 DO EN1^RMPREXT
EXIT ;common exit point
+1 SET XMSER="S."_XQSOP
SET XMZ=XQMSG
DO REMSBMSG^XMA1C
+2 KILL RMPRDAT1,RMPRDAT2,RMPRDT1,XMRG,XMSUB
+3 KILL RMPRDET,RMPRDOR1,RMPRDORS,RMPRDORW,RMPRDS1,RMPRDS2,RMPRDT2,RMPRMSG
+4 KILL RMPRPIP1,RMPRPIP2,XMDUZ,XMFROM,XMREC,XMSER,XMTEXT,XMY,XMZ,XQMSG,XQSOP,Y
+5 ;END
