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