- 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 Feb 19, 2025@00:01:02 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
