| [613] | 1 | RMPREXDS ;PHX/HNB -National Data Extract Pros Disability Codes - 10/30/96
|
|---|
| 2 | ;;3.0;PROSTHETICS;**18**;Feb 09, 1996
|
|---|
| 3 | ;can't enter from top
|
|---|
| 4 | Q
|
|---|
| 5 | EN(RMPRDT1,RMPRDT2) ;entry point
|
|---|
| 6 | ;send message to chief prosthetics notify of activation
|
|---|
| 7 | D NOT
|
|---|
| 8 | S RMPRB=0,CNT=1
|
|---|
| 9 | K ^TMP($J),^TMP("RMPR",$J),^TMP("RMPRF",$J)
|
|---|
| 10 | F S RMPRB=$O(^RMPR(660,"B",RMPRB)) Q:(RMPRB>RMPRDT2)!(RMPRB'>0) D
|
|---|
| 11 | .Q:RMPRB<RMPRDT1
|
|---|
| 12 | .S RMPRA=0
|
|---|
| 13 | .F S RMPRA=$O(^RMPR(660,"B",RMPRB,RMPRA)) Q:RMPRA'>0 D
|
|---|
| 14 | . .S DFN=$P($G(^RMPR(660,RMPRA,0)),U,2)
|
|---|
| 15 | . .Q:DFN=""
|
|---|
| 16 | . .Q:$D(^TMP("RMPR",$J,DFN))
|
|---|
| 17 | . .;leave out historical records
|
|---|
| 18 | . .Q:$P(^RMPR(660,RMPRA,0),U,15)
|
|---|
| 19 | . .S STN=$P(^RMPR(660,RMPRA,0),U,10)
|
|---|
| 20 | . .Q:STN=""
|
|---|
| 21 | . .S STN=$P($G(^DIC(4,STN,99)),U,1)
|
|---|
| 22 | . .Q:STN=""
|
|---|
| 23 | . .D SSN
|
|---|
| 24 | . .D DS
|
|---|
| 25 | . .D CK
|
|---|
| 26 | D:$D(^TMP($J)) MAIL1
|
|---|
| 27 | D MAILS
|
|---|
| 28 | Q
|
|---|
| 29 | DS ;patients disability codes/records
|
|---|
| 30 | Q:$D(^TMP("RMPR",$J,DFN))
|
|---|
| 31 | D GETS^DIQ(665,DFN_",","**","","RDIS")
|
|---|
| 32 | MERGE R19=RDIS(665.01)
|
|---|
| 33 | K RDIS
|
|---|
| 34 | Q:'$D(R19)
|
|---|
| 35 | S B1=0
|
|---|
| 36 | F S B1=$O(R19(B1)) Q:B1="" D
|
|---|
| 37 | .S B2=0
|
|---|
| 38 | .F S B2=$O(R19(B1,B2)) Q:B2="" D
|
|---|
| 39 | . .;format for mailman ^TMP($J,counter)=station number^ssn^field^value
|
|---|
| 40 | . .Q:B2=1
|
|---|
| 41 | . .Q:B2>5
|
|---|
| 42 | . .S ^TMP($J,CNT)=STN_U_RMPRSSN_U_B2_U_R19(B1,B2)
|
|---|
| 43 | . .S ^TMP("RMPR",$J,DFN)=""
|
|---|
| 44 | . .S CNT=CNT+1
|
|---|
| 45 | K R19,RMPRSSN,STN
|
|---|
| 46 | Q
|
|---|
| 47 | SSN ;pull ssn
|
|---|
| 48 | D DEM^VADPT
|
|---|
| 49 | S RMPRSSN=+VADM(2)
|
|---|
| 50 | K VADM
|
|---|
| 51 | Q
|
|---|
| 52 | NOT ;send notificaton to mail group
|
|---|
| 53 | S Y=RMPRDT1 D DD^%DT S RMPRDAT1=Y
|
|---|
| 54 | S Y=RMPRDT2 D DD^%DT S RMPRDAT2=Y
|
|---|
| 55 | S XMDUZ=.5
|
|---|
| 56 | S XMY("G.RMPR SERVER")=""
|
|---|
| 57 | S XMSUB="Prosthetics Data Extract "_RMPRDAT1_" to "_RMPRDAT2
|
|---|
| 58 | S RMPRMSG(1)="The National Data Server has been activated today by Prosthetics HQ."
|
|---|
| 59 | S RMPRMSG(2)="Data has been collected for the date range "_RMPRDAT1_" to "_RMPRDAT2_"."
|
|---|
| 60 | S RMPRMSG(3)="Disability Code information will be transmitted."
|
|---|
| 61 | S RMPRMSG(4)="This was activated by "_$P(XMFROM,"@",1)
|
|---|
| 62 | S RMPRMSG(5)=""
|
|---|
| 63 | S XMTEXT="RMPRMSG("
|
|---|
| 64 | D ^XMD
|
|---|
| 65 | K RMPRMSG,RMPRDAT1,RMPRDAT2
|
|---|
| 66 | Q
|
|---|
| 67 | CK ;check line length to send
|
|---|
| 68 | I CNT>4999 D MAIL1 S CNT=1 Q
|
|---|
| 69 | Q
|
|---|
| 70 | MAIL1 ;send message
|
|---|
| 71 | S XMTEXT="^TMP($J,"
|
|---|
| 72 | S XMDUZ=.5
|
|---|
| 73 | S XMY("G.PROSTHETICS@PSAS.MED.VA.GOV")=""
|
|---|
| 74 | S XMSUB="PSAS National Extract From "_$P($$SITE^VASITE,U,2)
|
|---|
| 75 | D ^XMD S RMPRXMZ(XMZ)=XMZ
|
|---|
| 76 | K ^TMP($J)
|
|---|
| 77 | Q
|
|---|
| 78 | MAIL ;send it
|
|---|
| 79 | S CNT=1
|
|---|
| 80 | F S RMPRA=$O(^TMP($J,RMPRA)) Q:RMPRA="" D
|
|---|
| 81 | .S ^TMP("RMPRF",$J,CNT)=^TMP($J,RMPRA)
|
|---|
| 82 | .K ^TMP($J,RMPRA)
|
|---|
| 83 | .S CNT=CNT+1
|
|---|
| 84 | .I CNT>4999 D
|
|---|
| 85 | . .S XMTEXT="^TMP(""RMPRF"",$J,"
|
|---|
| 86 | . .S XMDUZ=.5
|
|---|
| 87 | . .S XMY("G.PROSTHETICS@PSAS.MED.VA.GOV")=""
|
|---|
| 88 | . .S XMSUB="PSAS National Extract From "_$P($$SITE^VASITE,U,2)
|
|---|
| 89 | . .D ^XMD K ^TMP("RMPRF",$J) S RMPRXMZ(XMZ)=XMZ,CNT=1
|
|---|
| 90 | S XMTEXT="^TMP(""RMPRF"",$J,"
|
|---|
| 91 | S XMDUZ=.5
|
|---|
| 92 | S XMY("G.PROSTHETICS@PSAS.MED.VA.GOV")=""
|
|---|
| 93 | S XMSUB="PSAS National Extract From "_$P($$SITE^VASITE,U,2)
|
|---|
| 94 | D ^XMD K ^TMP("RMPRF",$J) S RMPRXMZ(XMZ)=XMZ
|
|---|
| 95 | MAILS ;mail summary message
|
|---|
| 96 | Q:'$D(RMPRXMZ)
|
|---|
| 97 | S RMPRB=0,RMPRTOT=0
|
|---|
| 98 | F S RMPRB=$O(^TMP("RMPR",$J,RMPRB)) Q:RMPRB="" S RMPRTOT=RMPRTOT+1
|
|---|
| 99 | S XMTEXT="RMPRXMZ("
|
|---|
| 100 | S RMPRXMZ(1)="Total Number of Unique SSN's for this site: "_RMPRTOT
|
|---|
| 101 | S XMDUZ=.5
|
|---|
| 102 | S XMY("G.PROSTHETICS@PSAS.MED.VA.GOV")=""
|
|---|
| 103 | S XMSUB="PSAS Summary National Extract From "_$P($$SITE^VASITE,U,2)
|
|---|
| 104 | D ^XMD
|
|---|
| 105 | ;END
|
|---|
