| [623] | 1 | RMPRSP7 ;HIN/RVD-PRINT 2319 WITHOUT SUSPENSE LINK ;3/17/03 08:13
|
|---|
| 2 | ;;3.0;PROSTHETICS;**62,69,77**;Feb 09, 1996
|
|---|
| 3 | ;RVD 8/27/01 patch #62 - PCE data print
|
|---|
| 4 | ;RVD 4/9/02 patch #69 - Disregard Historical data
|
|---|
| 5 | ;RVD 3/17/02 patch #77 - Fixed For Loop to include all PT 2319 records
|
|---|
| 6 | ; that are not linked
|
|---|
| 7 | ;
|
|---|
| 8 | D DIV4^RMPRSIT I $D(Y),(Y<0) Q
|
|---|
| 9 | ; Prompt for Start Date
|
|---|
| 10 | STDT ;RMPRSDT is start date in FM internal form.
|
|---|
| 11 | K %DT,X,Y
|
|---|
| 12 | S %DT("A")="Starting Date: "
|
|---|
| 13 | S %DT(0)=-DT
|
|---|
| 14 | S %DT="AEP"
|
|---|
| 15 | D ^%DT I Y<0 G EXIT1
|
|---|
| 16 | S RMPRSDT=$P(Y,".",1)
|
|---|
| 17 | S %DT("A")="Ending Date: ",%DT="AEX" D ^%DT G:Y<0 EXIT1
|
|---|
| 18 | S RMPREDT=$P(Y,".",1)
|
|---|
| 19 | I RMPRSDT>RMPREDT W !,$C(7),"Invalid Date Range Selection!!" G STDT
|
|---|
| 20 | ;
|
|---|
| 21 | CONT G:'$D(RMPRSDT) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 I '$D(IO("Q")) U IO G PRINT
|
|---|
| 22 | K IO("Q") S ZTDESC="PROSTHETIC PATIENT RECORDS WITHOUT SUSPENSE",ZTRTN="PRINT^RMPRSP7",ZTIO=ION,ZTSAVE("RMPRSDT")=""
|
|---|
| 23 | S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPR(")="",ZTSAVE("RMPREDT")=""
|
|---|
| 24 | D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
|
|---|
| 25 | ;
|
|---|
| 26 | PRINT I $E(IOST)["C" W !!,"Processing report......."
|
|---|
| 27 | K ^TMP($J)
|
|---|
| 28 | K %DT,X,Y
|
|---|
| 29 | S X="NOW" D ^%DT S RMDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
|
|---|
| 30 | S RMPAGE=1,(RMTOBAL,RMPREND)=0,RS=RMPR("STA")
|
|---|
| 31 | S RDT=RMPRSDT-1,RET=RMPREDT+1,RS=RMPR("STA")
|
|---|
| 32 | S Y=RMPRSDT D DD^%DT S RMSDAT=Y
|
|---|
| 33 | S Y=RMPREDT D DD^%DT S RMEDAT=Y
|
|---|
| 34 | D BUILD
|
|---|
| 35 | I '$D(^TMP($J)) D HEAD,NONE G EXIT
|
|---|
| 36 | D HEAD,HEAD1
|
|---|
| 37 | D WRITE
|
|---|
| 38 | G EXIT
|
|---|
| 39 | ;
|
|---|
| 40 | BUILD ;build a tmp global.
|
|---|
| 41 | 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
|
|---|
| 42 | .;don't include if O2 transactions.
|
|---|
| 43 | .Q:$D(^RMPO(665.72,"AC",RJ))
|
|---|
| 44 | .S RM0=$G(^RMPR(660,RJ,0))
|
|---|
| 45 | .S RM10=$G(^RMPR(660,RJ,10))
|
|---|
| 46 | .Q:($P(RM0,U,13)=13)!($P(RM0,U,15)="*")
|
|---|
| 47 | .Q:($P(RM10,U,14)>0)!($P(RM0,U,10)'=RMPR("STA"))
|
|---|
| 48 | .Q:$P(RM0,U,17)'=""
|
|---|
| 49 | .I $P(RM0,U,10)=RS D
|
|---|
| 50 | ..S RMDFN=$P(RM0,U,2)
|
|---|
| 51 | ..S RMITIEN=$P(RM0,U,6)
|
|---|
| 52 | ..S (RMITEM,RMPAT)=""
|
|---|
| 53 | ..I RMITIEN,($D(^RMPR(661,RMITIEN,0))),($D(^PRC(441,$P(^RMPR(661,RMITIEN,0),U,1),0))) D
|
|---|
| 54 | ...S RMITEM=$P(^PRC(441,$P(^RMPR(661,RMITIEN,0),U,1),0),U,2)
|
|---|
| 55 | ..S RMITEM=$E(RMITEM,1,18)
|
|---|
| 56 | ..I $D(^DPT(RMDFN,0)) S RMPAT=$E($P(^DPT(RMDFN,0),U,1),U,15)
|
|---|
| 57 | ..S RMSUSP=$P(RM10,U,1)
|
|---|
| 58 | ..S RMRXDT=$P(RM10,U,2)
|
|---|
| 59 | ..S RMIADT=$P(RM10,U,3)
|
|---|
| 60 | ..S RCDT=$P(RM10,U,4)
|
|---|
| 61 | ..S RMAMT=$P(RM0,U,16)
|
|---|
| 62 | ..S RMSRC=RJ
|
|---|
| 63 | ..S RMPRDI=$P(RM10,U,7)
|
|---|
| 64 | ..S RMINIE=$P(RM0,U,27)
|
|---|
| 65 | ..S RMCOSU=$P(RM10,U,9)
|
|---|
| 66 | ..S RMSUST=$P(RM10,U,11)
|
|---|
| 67 | ..S RMPCEP=$P(RM10,U,12)
|
|---|
| 68 | ..S RPDT=$P(RM10,U,13)
|
|---|
| 69 | ..I RMINIE,$D(^VA(200,RMINIE,0)) S RMINI=$E($P(^VA(200,RMINIE,0),U,1),1,10)
|
|---|
| 70 | ..E S RMINI=""
|
|---|
| 71 | ..S RDDT=$E(RI,4,5)_"/"_$E(RI,6,7)_"/"_$E(RI,2,3)
|
|---|
| 72 | ..S:RPDT'="" RPDT=$E(RPDT,4,5)_"/"_$E(RPDT,6,7)_"/"_$E(RPDT,2,3)
|
|---|
| 73 | ..S:RCDT'="" RCDT=$E(RCDT,4,5)_"/"_$E(RCDT,6,7)_"/"_$E(RCDT,2,3)
|
|---|
| 74 | ..S ^TMP($J,RI,RMPAT,RJ)=RMITEM_"^"_RDDT_"^"_RMAMT_"^"_RMSRC_"^"_RMINI_"^"_RPDT_"^"_$E(RMPRDI,1,10)
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | WRITE ;write report to a selected device
|
|---|
| 78 | S (RMPREND,RI,RM)=0
|
|---|
| 79 | F S RI=$O(^TMP($J,RI)) Q:(RI'>0)!(RMPREND) S RJ="" F S RJ=$O(^TMP($J,RI,RJ)) Q:(RJ="")!(RMPREND) F S RM=$O(^TMP($J,RI,RJ,RM)) Q:(RM'>0)!(RMPREND) D
|
|---|
| 80 | .S RMDAT=$G(^TMP($J,RI,RJ,RM))
|
|---|
| 81 | .S RMPAT=RJ
|
|---|
| 82 | .S RMITEM=$P(RMDAT,U,1)
|
|---|
| 83 | .S RDDT=$P(RMDAT,U,2)
|
|---|
| 84 | .S RMAMT=$P(RMDAT,U,3)
|
|---|
| 85 | .S RMSRC=$P(RMDAT,U,4)
|
|---|
| 86 | .S RMINI=$P(RMDAT,U,5)
|
|---|
| 87 | .S RPDT=$P(RMDAT,U,6)
|
|---|
| 88 | .S RMPRDI=$E($P(RMDAT,U,7),1,12)
|
|---|
| 89 | .W !,RDDT,?10,RMPAT,?26,RMITEM,?45,$J(RMAMT,8,2),?57,RMSRC,?67,RMINI
|
|---|
| 90 | .S RMPRFLG=1
|
|---|
| 91 | .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
|
|---|
| 92 | .I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 K RMPRFLG Q
|
|---|
| 93 | W !,RMPR("L")
|
|---|
| 94 | W !,"<End of Report>"
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | HEAD W !,"PROSTHETICS PATIENT RECORDS NOT LINKED TO SUSPENSE Run Date:",RMDATE,?70,"PAGE: ",RMPAGE
|
|---|
| 98 | W !,"Start Date: ",RMSDAT,?26,"End Date: ",RMEDAT,?51,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,19)
|
|---|
| 99 | S RMPAGE=RMPAGE+1
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | 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
|
|---|
| 103 | I $E(IOST)'["C"&($Y>(IOSL-6)) W @IOF D HEAD
|
|---|
| 104 | W !,RMPR("L")
|
|---|
| 105 | W !,"DATE",?10,"PATIENT",?26,"ITEM",?49,"COST",?57,"VISTA #",?67,"INITIATOR"
|
|---|
| 106 | W !,"----",?10,"-------",?26,"----",?49,"----",?57,"-------",?67,"---------"
|
|---|
| 107 | S RMPRFLG=1
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | EXIT I $E(IOST)["C",'RMPREND K DIR S DIR(0)="E" D ^DIR
|
|---|
| 111 | EXIT1 D ^%ZISC
|
|---|
| 112 | K ^TMP($J)
|
|---|
| 113 | N RMPR,RMPRSITE D KILL^XUSCLEAN
|
|---|
| 114 | Q
|
|---|
| 115 | NONE W !!,"NO DATA TO PRINT !!!!!"
|
|---|
| 116 | Q
|
|---|
