RMPREXDS ;PHX/HNB -National Data Extract Pros Disability Codes - 10/30/96
;;3.0;PROSTHETICS;**18**;Feb 09, 1996
;can't enter from top
Q
EN(RMPRDT1,RMPRDT2) ;entry point
;send message to chief prosthetics notify of activation
D NOT
S RMPRB=0,CNT=1
K ^TMP($J),^TMP("RMPR",$J),^TMP("RMPRF",$J)
F S RMPRB=$O(^RMPR(660,"B",RMPRB)) Q:(RMPRB>RMPRDT2)!(RMPRB'>0) D
.Q:RMPRB<RMPRDT1
.S RMPRA=0
.F S RMPRA=$O(^RMPR(660,"B",RMPRB,RMPRA)) Q:RMPRA'>0 D
. .S DFN=$P($G(^RMPR(660,RMPRA,0)),U,2)
. .Q:DFN=""
. .Q:$D(^TMP("RMPR",$J,DFN))
. .;leave out historical records
. .Q:$P(^RMPR(660,RMPRA,0),U,15)
. .S STN=$P(^RMPR(660,RMPRA,0),U,10)
. .Q:STN=""
. .S STN=$P($G(^DIC(4,STN,99)),U,1)
. .Q:STN=""
. .D SSN
. .D DS
. .D CK
D:$D(^TMP($J)) MAIL1
D MAILS
Q
DS ;patients disability codes/records
Q:$D(^TMP("RMPR",$J,DFN))
D GETS^DIQ(665,DFN_",","**","","RDIS")
MERGE R19=RDIS(665.01)
K RDIS
Q:'$D(R19)
S B1=0
F S B1=$O(R19(B1)) Q:B1="" D
.S B2=0
.F S B2=$O(R19(B1,B2)) Q:B2="" D
. .;format for mailman ^TMP($J,counter)=station number^ssn^field^value
. .Q:B2=1
. .Q:B2>5
. .S ^TMP($J,CNT)=STN_U_RMPRSSN_U_B2_U_R19(B1,B2)
. .S ^TMP("RMPR",$J,DFN)=""
. .S CNT=CNT+1
K R19,RMPRSSN,STN
Q
SSN ;pull ssn
D DEM^VADPT
S RMPRSSN=+VADM(2)
K VADM
Q
NOT ;send notificaton to mail group
S Y=RMPRDT1 D DD^%DT S RMPRDAT1=Y
S Y=RMPRDT2 D DD^%DT S RMPRDAT2=Y
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)="Disability Code information will be transmitted."
S RMPRMSG(4)="This was activated by "_$P(XMFROM,"@",1)
S RMPRMSG(5)=""
S XMTEXT="RMPRMSG("
D ^XMD
K RMPRMSG,RMPRDAT1,RMPRDAT2
Q
CK ;check line length to send
I CNT>4999 D MAIL1 S CNT=1 Q
Q
MAIL1 ;send message
S XMTEXT="^TMP($J,"
S XMDUZ=.5
S XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
S XMSUB="PSAS National Extract From "_$P($$SITE^VASITE,U,2)
D ^XMD S RMPRXMZ(XMZ)=XMZ
K ^TMP($J)
Q
MAIL ;send it
S CNT=1
F S RMPRA=$O(^TMP($J,RMPRA)) Q:RMPRA="" D
.S ^TMP("RMPRF",$J,CNT)=^TMP($J,RMPRA)
.K ^TMP($J,RMPRA)
.S CNT=CNT+1
.I CNT>4999 D
. .S XMTEXT="^TMP(""RMPRF"",$J,"
. .S XMDUZ=.5
. .S XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
. .S XMSUB="PSAS National Extract From "_$P($$SITE^VASITE,U,2)
. .D ^XMD K ^TMP("RMPRF",$J) S RMPRXMZ(XMZ)=XMZ,CNT=1
S XMTEXT="^TMP(""RMPRF"",$J,"
S XMDUZ=.5
S XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
S XMSUB="PSAS National Extract From "_$P($$SITE^VASITE,U,2)
D ^XMD K ^TMP("RMPRF",$J) S RMPRXMZ(XMZ)=XMZ
MAILS ;mail summary message
Q:'$D(RMPRXMZ)
S RMPRB=0,RMPRTOT=0
F S RMPRB=$O(^TMP("RMPR",$J,RMPRB)) Q:RMPRB="" S RMPRTOT=RMPRTOT+1
S XMTEXT="RMPRXMZ("
S RMPRXMZ(1)="Total Number of Unique SSN's for this site: "_RMPRTOT
S XMDUZ=.5
S XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
S XMSUB="PSAS Summary National Extract From "_$P($$SITE^VASITE,U,2)
D ^XMD
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREXDS 3147 printed Nov 22, 2024@17:44:36 Page 2
RMPREXDS ;PHX/HNB -National Data Extract Pros Disability Codes - 10/30/96
+1 ;;3.0;PROSTHETICS;**18**;Feb 09, 1996
+2 ;can't enter from top
+3 QUIT
EN(RMPRDT1,RMPRDT2) ;entry point
+1 ;send message to chief prosthetics notify of activation
+2 DO NOT
+3 SET RMPRB=0
SET CNT=1
+4 KILL ^TMP($JOB),^TMP("RMPR",$JOB),^TMP("RMPRF",$JOB)
+5 FOR
SET RMPRB=$ORDER(^RMPR(660,"B",RMPRB))
if (RMPRB>RMPRDT2)!(RMPRB'>0)
QUIT
Begin DoDot:1
+6 if RMPRB<RMPRDT1
QUIT
+7 SET RMPRA=0
+8 FOR
SET RMPRA=$ORDER(^RMPR(660,"B",RMPRB,RMPRA))
if RMPRA'>0
QUIT
Begin DoDot:2
+9 SET DFN=$PIECE($GET(^RMPR(660,RMPRA,0)),U,2)
+10 if DFN=""
QUIT
+11 if $DATA(^TMP("RMPR",$JOB,DFN))
QUIT
+12 ;leave out historical records
+13 if $PIECE(^RMPR(660,RMPRA,0),U,15)
QUIT
+14 SET STN=$PIECE(^RMPR(660,RMPRA,0),U,10)
+15 if STN=""
QUIT
+16 SET STN=$PIECE($GET(^DIC(4,STN,99)),U,1)
+17 if STN=""
QUIT
+18 DO SSN
+19 DO DS
+20 DO CK
End DoDot:2
End DoDot:1
+21 if $DATA(^TMP($JOB))
DO MAIL1
+22 DO MAILS
+23 QUIT
DS ;patients disability codes/records
+1 if $DATA(^TMP("RMPR",$JOB,DFN))
QUIT
+2 DO GETS^DIQ(665,DFN_",","**","","RDIS")
+3 MERGE R19=RDIS(665.01)
+4 KILL RDIS
+5 if '$DATA(R19)
QUIT
+6 SET B1=0
+7 FOR
SET B1=$ORDER(R19(B1))
if B1=""
QUIT
Begin DoDot:1
+8 SET B2=0
+9 FOR
SET B2=$ORDER(R19(B1,B2))
if B2=""
QUIT
Begin DoDot:2
+10 ;format for mailman ^TMP($J,counter)=station number^ssn^field^value
+11 if B2=1
QUIT
+12 if B2>5
QUIT
+13 SET ^TMP($JOB,CNT)=STN_U_RMPRSSN_U_B2_U_R19(B1,B2)
+14 SET ^TMP("RMPR",$JOB,DFN)=""
+15 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+16 KILL R19,RMPRSSN,STN
+17 QUIT
SSN ;pull ssn
+1 DO DEM^VADPT
+2 SET RMPRSSN=+VADM(2)
+3 KILL VADM
+4 QUIT
NOT ;send notificaton to mail group
+1 SET Y=RMPRDT1
DO DD^%DT
SET RMPRDAT1=Y
+2 SET Y=RMPRDT2
DO DD^%DT
SET RMPRDAT2=Y
+3 SET XMDUZ=.5
+4 SET XMY("G.RMPR SERVER")=""
+5 SET XMSUB="Prosthetics Data Extract "_RMPRDAT1_" to "_RMPRDAT2
+6 SET RMPRMSG(1)="The National Data Server has been activated today by Prosthetics HQ."
+7 SET RMPRMSG(2)="Data has been collected for the date range "_RMPRDAT1_" to "_RMPRDAT2_"."
+8 SET RMPRMSG(3)="Disability Code information will be transmitted."
+9 SET RMPRMSG(4)="This was activated by "_$PIECE(XMFROM,"@",1)
+10 SET RMPRMSG(5)=""
+11 SET XMTEXT="RMPRMSG("
+12 DO ^XMD
+13 KILL RMPRMSG,RMPRDAT1,RMPRDAT2
+14 QUIT
CK ;check line length to send
+1 IF CNT>4999
DO MAIL1
SET CNT=1
QUIT
+2 QUIT
MAIL1 ;send message
+1 SET XMTEXT="^TMP($J,"
+2 SET XMDUZ=.5
+3 SET XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
+4 SET XMSUB="PSAS National Extract From "_$PIECE($$SITE^VASITE,U,2)
+5 DO ^XMD
SET RMPRXMZ(XMZ)=XMZ
+6 KILL ^TMP($JOB)
+7 QUIT
MAIL ;send it
+1 SET CNT=1
+2 FOR
SET RMPRA=$ORDER(^TMP($JOB,RMPRA))
if RMPRA=""
QUIT
Begin DoDot:1
+3 SET ^TMP("RMPRF",$JOB,CNT)=^TMP($JOB,RMPRA)
+4 KILL ^TMP($JOB,RMPRA)
+5 SET CNT=CNT+1
+6 IF CNT>4999
Begin DoDot:2
+7 SET XMTEXT="^TMP(""RMPRF"",$J,"
+8 SET XMDUZ=.5
+9 SET XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
+10 SET XMSUB="PSAS National Extract From "_$PIECE($$SITE^VASITE,U,2)
+11 DO ^XMD
KILL ^TMP("RMPRF",$JOB)
SET RMPRXMZ(XMZ)=XMZ
SET CNT=1
End DoDot:2
End DoDot:1
+12 SET XMTEXT="^TMP(""RMPRF"",$J,"
+13 SET XMDUZ=.5
+14 SET XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
+15 SET XMSUB="PSAS National Extract From "_$PIECE($$SITE^VASITE,U,2)
+16 DO ^XMD
KILL ^TMP("RMPRF",$JOB)
SET RMPRXMZ(XMZ)=XMZ
MAILS ;mail summary message
+1 if '$DATA(RMPRXMZ)
QUIT
+2 SET RMPRB=0
SET RMPRTOT=0
+3 FOR
SET RMPRB=$ORDER(^TMP("RMPR",$JOB,RMPRB))
if RMPRB=""
QUIT
SET RMPRTOT=RMPRTOT+1
+4 SET XMTEXT="RMPRXMZ("
+5 SET RMPRXMZ(1)="Total Number of Unique SSN's for this site: "_RMPRTOT
+6 SET XMDUZ=.5
+7 SET XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
+8 SET XMSUB="PSAS Summary National Extract From "_$PIECE($$SITE^VASITE,U,2)
+9 DO ^XMD
+10 ;END
