Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPCER

RMPRPCER.m

Go to the documentation of this file.
  1. RMPRPCER ;HIN/RVD-PRINT PCE DATA ;7/3/01
  1. ;;3.0;PROSTHETICS;**62**;Feb 09, 1996
  1. ;RVD 7/3/01 patch #62 - PCE data print
  1. ;
  1. D DIV4^RMPRSIT I $D(Y),(Y<0) Q
  1. ; Prompt for Start Date
  1. STDT ;RMPRSDT is start date in FM internal form.
  1. K %DT,X,Y
  1. S %DT("A")="Starting Date: "
  1. S %DT(0)=-DT
  1. S %DT="AEP"
  1. D ^%DT I Y<0 G EXIT1
  1. S RMPRSDT=$P(Y,".",1)
  1. S %DT("A")="Ending Date: ",%DT="AEX" D ^%DT G:Y<0 EXIT1
  1. S RMPREDT=$P(Y,".",1)
  1. I RMPRSDT>RMPREDT W !,$C(7),"Invalid Date Range Selection!!" G STDT
  1. ;
  1. CONT G:'$D(RMPRSDT) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 I '$D(IO("Q")) U IO G PRINT
  1. K IO("Q") S ZTDESC="PROSTHETIC PCE DATA",ZTRTN="PRINT^RMPRPCER",ZTIO=ION,ZTSAVE("RMPRSDT")=""
  1. S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPR(")="",ZTSAVE("RMPREDT")=""
  1. D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
  1. ;
  1. PRINT I $E(IOST)["C" W !!,"Processing report......."
  1. K ^TMP($J)
  1. K %DT,X,Y
  1. S X="NOW" D ^%DT S RMRDAT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
  1. S RMPAGE=1,(RMTOBAL,RMPREND)=0,RS=RMPR("STA")
  1. S RDT=RMPRSDT-1,RET=RMPREDT+1,RS=RMPR("STA")
  1. S Y=RMPRSDT D DD^%DT S RMSDAT=Y
  1. S Y=RMPREDT D DD^%DT S RMEDAT=Y
  1. D BUILD
  1. I '$D(^TMP($J)) D HEAD,NONE G EXIT
  1. D HEAD,HEAD1
  1. D WRITE
  1. G EXIT
  1. ;
  1. BUILD ;build a tmp global.
  1. F RI=RDT:0:RET S RI=$O(^RMPR(660,"B",RI)) Q:(RI'>0)!(RMPREND)!(RI>RMPREDT) F RJ=0:0 S RJ=$O(^RMPR(660,"B",RI,RJ)) Q:(RJ'>0) D
  1. .S RM0=$G(^RMPR(660,RJ,0))
  1. .S RM10=$G(^RMPR(660,RJ,10))
  1. .Q:$P(RM10,U,12)'>0
  1. .I $P(RM0,U,10)=RS D
  1. ..S RMDFN=$P(RM0,U,2)
  1. ..S RMITIEN=$P(RM0,U,6)
  1. ..S (RMITEM,RMPAT)=""
  1. ..I RMITIEN,($D(^RMPR(661,RMITIEN,0))),($D(^PRC(441,$P(^RMPR(661,RMITIEN,0),U,1),0))) D
  1. ...S RMITEM=$P(^PRC(441,$P(^RMPR(661,RMITIEN,0),U,1),0),U,2)
  1. ..S RMITEM=$E(RMITEM,1,8)
  1. ..I $D(^DPT(RMDFN,0)) S RMPAT=$E($P(^DPT(RMDFN,0),U,1),U,10)
  1. ..S RMSUSP=$P(RM10,U,1)
  1. ..S RMRXDT=$P(RM10,U,2)
  1. ..S RMIADT=$P(RM10,U,3)
  1. ..S RCDT=$P(RM10,U,4)
  1. ..S RMTYRE=$P(RM10,U,5)
  1. ..S RMSURE=$P(RM10,U,6)
  1. ..S RMPRDI=$P(RM10,U,7)
  1. ..S RMICD9=$P(RM10,U,8)
  1. ..S RMCOSU=$P(RM10,U,9)
  1. ..S RMSUST=$P(RM10,U,11)
  1. ..S RMPCEP=$P(RM10,U,12)
  1. ..S RPDT=$P(RM10,U,13)
  1. ..I RMICD9,($D(^ICD9(RMICD9,0))) S RMICD=$P(^ICD9(RMICD9,0),U,1)
  1. ..E S RMICD=""
  1. ..S:RMTYRE'="" RMTYRE=$E(RMTYRE,1,8)
  1. ..I RMSURE,($D(^VA(200,RMSURE,0))) S RMSURE=$E($P(^VA(200,RMSURE,0),U,1),1,9)
  1. ..S RDDT=$E(RI,4,5)_"/"_$E(RI,6,7)_"/"_$E(RI,2,3)
  1. ..S:RPDT'="" RPDT=$E(RPDT,4,5)_"/"_$E(RPDT,6,7)_"/"_$E(RPDT,2,3)
  1. ..S:RCDT'="" RCDT=$E(RCDT,4,5)_"/"_$E(RCDT,6,7)_"/"_$E(RCDT,2,3)
  1. ..S ^TMP($J,RI,RMPAT)=RMITEM_"^"_RDDT_"^"_RMTYRE_"^"_RMSURE_"^"_RMICD_"^"_RPDT_"^"_$E(RMPRDI,1,9)
  1. Q
  1. ;
  1. WRITE ;write report to a selected device
  1. S RI=0
  1. F S RI=$O(^TMP($J,RI)) Q:RI'>0!$G(RMPREND) S RJ="" F S RJ=$O(^TMP($J,RI,RJ)) Q:RJ=""!$G(RMPREND) D
  1. .S RMDAT=$G(^TMP($J,RI,RJ))
  1. .S RMPAT=RJ
  1. .S RMITEM=$P(RMDAT,U,1)
  1. .S RDDT=$P(RMDAT,U,2)
  1. .S RMTYRE=$P(RMDAT,U,3)
  1. .S RMSURE=$P(RMDAT,U,4)
  1. .S RMICD=$P(RMDAT,U,5)
  1. .S RPDT=$P(RMDAT,U,6)
  1. .S RMPRDI=$E($P(RMDAT,U,7),1,12)
  1. .W !,RDDT,?10,RMPAT,?21,RMITEM,?30,RMTYRE,?40,RMSURE,?51,RMICD,?58,RPDT,?68,RMPRDI
  1. .S RMPRFLG=1
  1. .I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q
  1. .I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 K RMPRFLG Q
  1. W !,RMPR("L")
  1. W !,"<End of Report>"
  1. Q
  1. ;
  1. W !,"Start Date: ",RMSDAT,?26,"End Date: ",RMEDAT,?51,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,19)
  1. S RMPAGE=RMPAGE+1
  1. Q
  1. ;
  1. HEAD1 I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD
  1. I $E(IOST)'["C"&($Y>(IOSL-6)) W @IOF D HEAD
  1. W !,RMPR("L")
  1. W !?30,"TYPE OF",?42,"CPRS",?60,"PCE"
  1. W !,"DATE",?10,"PATIENT",?21,"ITEM",?30,"REQUEST",?40,"REQUESTOR",?51,"ICD9",?60,"DATE",?68,"DIAGNOSIS"
  1. W !,"----",?10,"-------",?21,"----",?30,"-------",?40,"---------",?51,"----",?58,"--------",?68,"---------"
  1. S RMPRFLG=1
  1. Q
  1. ;
  1. EXIT I $E(IOST)["C",'RMPREND K DIR S DIR(0)="E" D ^DIR
  1. EXIT1 D ^%ZISC
  1. K ^TMP($J)
  1. N RMPR,RMPRSITE D KILL^XUSCLEAN
  1. Q
  1. NONE W !!,"NO DATA TO PRINT !!!!!"
  1. Q