| 1 | RMPRESRV ;PHX/HNC - SERVER ROUTINE FOR NATIONAL DATA EXTRACT ; 1/19/2005
|
|---|
| 2 | ;;3.0;PROSTHETICS;**12,18,24,51,59,103**;Feb 09, 1996
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;DBIA # 10072 - for routine REMSBMSG^XMA1C
|
|---|
| 6 | ;
|
|---|
| 7 | ;HCPCS SERVER - patch 103, HNC 1/19/2005
|
|---|
| 8 | ;
|
|---|
| 9 | ;modified to include the PIP extract 9/28/00
|
|---|
| 10 | X XMREC D
|
|---|
| 11 | .;disability codes
|
|---|
| 12 | .I XMRG["DS1" S RMPRDS1=$P(XMRG,"*",2)
|
|---|
| 13 | .I XMRG["DS2" S RMPRDS2=$P(XMRG,"*",4)
|
|---|
| 14 | .;new and repair worksheets
|
|---|
| 15 | .I XMRG["DT1" S RMPRDT1=$P(XMRG,"*",2)
|
|---|
| 16 | .I XMRG["DT2" S RMPRDT2=$P(XMRG,"*",4)
|
|---|
| 17 | .;suspense delayed order report
|
|---|
| 18 | .I XMRG["DOR1" S RMPRDOR1=$P(XMRG,"*",2)
|
|---|
| 19 | .I XMRG["DOR1" S RMPRDORS=$P(XMRG,"*",3)
|
|---|
| 20 | .I XMRG["DOR1" S RMPRDORW=$P(XMRG,"*",4)
|
|---|
| 21 | .I XMRG["DOR1" D A1^RMPR9DO("00","99","ALL",RMPRDORS,RMPRDOR1,RMPRDORW) S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C Q
|
|---|
| 22 | ;new items to file 661.1
|
|---|
| 23 | I XMRG="ITEM SERVER 661.1" G EN^RMPRET
|
|---|
| 24 | ;pip EXCEL extract
|
|---|
| 25 | I $P(XMRG,"*",1)="PIP ROLL-UP" S RMPRPIP1=$P(XMRG,"*",2),RMPRPIP2=$P(XMRG,"*",3) G ^RMPR5HQ1
|
|---|
| 26 | ;pip REPORT extract
|
|---|
| 27 | I $P(XMRG,"*",1)="PIP REPORT" S RMPRPIP1=$P(XMRG,"*",2),RMPRPIP2=$P(XMRG,"*",3),RMPRDET=$P(XMRG,"*",4) G ^RMPR5HQA
|
|---|
| 28 | ;open obligations
|
|---|
| 29 | I XMRG="PR2" G PR2^RMPREXT
|
|---|
| 30 | I $D(RMPRDS1)&($D(RMPRDS2)) D EN^RMPREXDS(RMPRDS1,RMPRDS2) G EXIT
|
|---|
| 31 | I '$D(RMPRDT1)!('$D(RMPRDT2)) G EXIT
|
|---|
| 32 | ;dates for message subject
|
|---|
| 33 | S Y=RMPRDT1 D DD^%DT S RMPRDAT1=Y
|
|---|
| 34 | S Y=RMPRDT2 D DD^%DT S RMPRDAT2=Y
|
|---|
| 35 | ;send message to group so they know the server was activated
|
|---|
| 36 | S XMDUZ=.5
|
|---|
| 37 | S XMY("G.RMPR SERVER")=""
|
|---|
| 38 | S XMSUB="Prosthetics Data Extract "_RMPRDAT1_" to "_RMPRDAT2
|
|---|
| 39 | S RMPRMSG(1)="The National Data Server has been activated today by Prosthetics HQ."
|
|---|
| 40 | S RMPRMSG(2)="Data has been collected for the date range "_RMPRDAT1_" to "_RMPRDAT2_"."
|
|---|
| 41 | S RMPRMSG(3)=""
|
|---|
| 42 | S RMPRMSG(4)="This was activated by "_$P(XMFROM,"@",1)
|
|---|
| 43 | S RMPRMSG(5)=""
|
|---|
| 44 | S XMTEXT="RMPRMSG("
|
|---|
| 45 | D ^XMD
|
|---|
| 46 | ;refresh amis codes in file 660
|
|---|
| 47 | D ^RMPREXR
|
|---|
| 48 | ;gather and send the raw data
|
|---|
| 49 | ;add additional extract here if needed
|
|---|
| 50 | D EN1^RMPREXT
|
|---|
| 51 | EXIT ;common exit point
|
|---|
| 52 | S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
|
|---|
| 53 | K RMPRDAT1,RMPRDAT2,RMPRDT1,XMRG,XMSUB
|
|---|
| 54 | K RMPRDET,RMPRDOR1,RMPRDORS,RMPRDORW,RMPRDS1,RMPRDS2,RMPRDT2,RMPRMSG
|
|---|
| 55 | K RMPRPIP1,RMPRPIP2,XMDUZ,XMFROM,XMREC,XMSER,XMTEXT,XMY,XMZ,XQMSG,XQSOP,Y
|
|---|
| 56 | ;END
|
|---|
