| 1 | RMPR5N1 ;HIN/RVD-PROS STOCK ITEM RECORDS ;3/17/03 13:19
|
---|
| 2 | ;;3.0;PROSTHETICS;**33,77**;Feb 09, 1996
|
---|
| 3 | ;RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
|
---|
| 4 | D DIV4^RMPRSIT I $D(Y),(Y<0) Q
|
---|
| 5 | ;
|
---|
| 6 | EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS S DIC="^RMPR(661.1,",DIC(0)="AEQM",DIC("S")="I $D(^RMPR(661.1,+Y,3,0))"
|
---|
| 7 | F HCPCS=1:1 S DIC("A")="Select HCPCS "_HCPCS_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(HCPCS=1)) EXIT1 Q:X="" D
|
---|
| 8 | .Q:'$D(^RMPR(661.1,+Y,0)) S RMHCPC=$P(^RMPR(661.1,+Y,0),U,1)
|
---|
| 9 | .I $D(RMPRI(RMHCPC)) W $C(7)," ??",?40,"..Duplicate HCPCS" S HCPCS=HCPCS-1 Q
|
---|
| 10 | .S:RMHCPC'="" RMPRI(RMHCPC)=+Y
|
---|
| 11 | S RMPRCOUN=0 W !! S %DT("A")="Beginning Date: ",%DT="AEPX",%DT("B")="T-30" D ^%DT S RMPRBDT=Y G:Y<0 EXIT1
|
---|
| 12 | ENDATE S %DT("A")="Ending Date: ",%DT="AEX",%DT("B")="TODAY" D ^%DT G:Y<0 EXIT1 I RMPRBDT>Y W !,$C(7),"Invalid Date Range Selection!!" G ENDATE
|
---|
| 13 | G:Y<0 EXIT S RMPREDT=Y,Y=RMPRBDT D DD^%DT S RMPRX=Y,Y=RMPREDT D DD^%DT S RMPRY=Y
|
---|
| 14 | S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT
|
---|
| 15 | I '$D(IO("Q")) U IO G PRINT
|
---|
| 16 | K IO("Q") S ZTDESC="STOCK ITEM REPORT",ZTRTN="PRINT^RMPR5N1",ZTIO=ION,ZTSAVE("RMPRBDT")="",ZTSAVE("RMPREDT")="",ZTSAVE("RMPRI(")="",ZTSAVE("RMPRX")="",ZTSAVE("RMPRY")="",ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPR(")=""
|
---|
| 17 | D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
|
---|
| 18 | ;
|
---|
| 19 | PRINT I $E(IOST)["C" W @IOF,!!,"Processing report......"
|
---|
| 20 | ;Entry point of printing report.
|
---|
| 21 | S RMBDATE=$E(RMPRBDT,4,5)_"/"_$E(RMPRBDT,6,7)_"/"_$E(RMPRBDT,2,3)
|
---|
| 22 | I '$D(RMPRI) D NONEALL G EXIT
|
---|
| 23 | S RMPAGE=1,(RMPREND,RP,QTYT,RMIFL,RMCO,RMTOCO,RMTOCOH)=0
|
---|
| 24 | D HEAD
|
---|
| 25 | ;
|
---|
| 26 | PRI S RQ="" F S RQ=$O(RMPRI(RQ)) Q:RQ="" S RMD=RMPRI(RQ) D PRI1
|
---|
| 27 | S R0="" D WRI
|
---|
| 28 | G EXIT
|
---|
| 29 | ;
|
---|
| 30 | PRI1 S (RMSTAFL,RMSUF,RMQTYT)=0
|
---|
| 31 | S RO=0 F S RO=$O(^RMPR(661.2,"D",RMD,RO)) Q:(RO'>0)!(RMPREND) D REST
|
---|
| 32 | D:'RMSTAFL NONE
|
---|
| 33 | Q
|
---|
| 34 | ;
|
---|
| 35 | EXIT ;EXIT FROM REPORT HERE
|
---|
| 36 | ;I $E(IOST)["C"&($Y<22) F W ! Q:$Y>20
|
---|
| 37 | I $E(IOST)["C",'$D(DUOUT),'RMPREND K DIR S DIR(0)="E" D ^DIR
|
---|
| 38 | EXIT1 D ^%ZISC
|
---|
| 39 | N RMPR,RMPRSITE D KILL^XUSCLEAN
|
---|
| 40 | Q
|
---|
| 41 | ;
|
---|
| 42 | REST ;
|
---|
| 43 | S RMSUF=1
|
---|
| 44 | S RMSSN=""
|
---|
| 45 | S RM2=$G(^RMPR(661.2,RO,0)) Q:RM2=""
|
---|
| 46 | Q:'$P(RM2,U,16)
|
---|
| 47 | S RMDAT=$P(RM2,U,1),RMSTA=$P(RM2,U,15) Q:RMSTA'=RMPR("STA")
|
---|
| 48 | Q:RMDAT<RMPRBDT!(RMDAT>RMPREDT)
|
---|
| 49 | S:RMSTA=RMPR("STA") RMSTAFL=1
|
---|
| 50 | S RMPAT=$P(RM2,U,2),RMSO=$P(RM2,U,3),RMUNI=$P(RM2,U,5),RMAVCO=$P(RM2,U,17)
|
---|
| 51 | S RMUSR=$P(RM2,U,7),RMBA=$P(RM2,U,8),RMCOM=$P(RM2,U,13),RMHI=$P(RM2,U,9)
|
---|
| 52 | S RMHCPC=$P(RMHI,"-",1),RMONO=$P(RM2,U,10),RMREC=$P(RM2,U,11),RMCUB=$P(RM2,U,12)
|
---|
| 53 | S RMDAHC=$O(^RMPR(661.1,"B",RMHCPC,0)) Q:'RMDAHC
|
---|
| 54 | S RMDAIT=$P(RMHI,"-",2),RMSER=$P(RM2,U,6)
|
---|
| 55 | S RMDAT=$E(RMDAT,4,5)_"/"_$E(RMDAT,6,7)_"/"_$E(RMDAT,2,3)
|
---|
| 56 | S RM1=$G(^RMPR(661.1,RMDAHC,3,RMDAIT,0))
|
---|
| 57 | Q:RM1=""
|
---|
| 58 | S RMITEM=$P(RM1,U,1)
|
---|
| 59 | SET ;
|
---|
| 60 | S ^TMP($J,RQ,RMITEM,RO)="^^"_RMPAT_"^"_RMSO_"^"_RMUSR_"^"_RMBA_"^"_RMONO_"^"_RMREC_"^"_RMCUB_"^"_RMCOM_"^"_RMAVCO_"^"_RMDAT_"^"_RMSER
|
---|
| 61 | Q
|
---|
| 62 | ;
|
---|
| 63 | WRI S (RMFH,RMFI,RMPRFLG,RMTOCOH,RMTOCOI)=0
|
---|
| 64 | S RMITEM=""
|
---|
| 65 | F S R0=$O(^TMP($J,R0)) D:RMFH HTOTAL D:R0'="" HEAD1 Q:R0="" S R1="" F S R1=$O(^TMP($J,R0,R1)) D:RMFI ITOTAL Q:R1="" D:RMITEM'=R1 IHEAD F R2=0:0 S R2=$O(^TMP($J,R0,R1,R2)) Q:(R2'>0)!(RMPREND) D
|
---|
| 66 | .S RDATA=^TMP($J,R0,R1,R2)
|
---|
| 67 | .S RMDAT=$P(RDATA,U,12),RMAV=$P(RDATA,U,1),RMUNI=$P(RDATA,U,2)
|
---|
| 68 | .S RMPAT=$P(RDATA,U,3),RMSO=$P(RDATA,U,4)
|
---|
| 69 | .S RMUSR=$P(RDATA,U,5),RMQTY=$P(RDATA,U,6),RMONO=$P(RDATA,U,7)
|
---|
| 70 | .S RMREC=$P(RDATA,U,8),RMCUB=$P(RDATA,U,9),RMCOM=$P(RDATA,U,10)
|
---|
| 71 | .S RMSER=$E($P(RDATA,U,13),1,14)
|
---|
| 72 | .S RMAVCO=$P(RDATA,U,11) S:RMAVCO'="" RMCO=RMAVCO*RMQTY
|
---|
| 73 | .S RMITEM=R1
|
---|
| 74 | .I 'RMPRFLG D HEAD1
|
---|
| 75 | .S:RMUSR RMUSR=$E($P(^VA(200,RMUSR,0),U,1),1,12)
|
---|
| 76 | .S:RMPAT RMSSN=$E($P(^DPT(RMPAT,0),U,9),6,9)
|
---|
| 77 | .S (RMFH,RMFI)=1
|
---|
| 78 | .W !,RMDAT
|
---|
| 79 | .I RMPAT W ?9,$E($P(^DPT(RMPAT,0),U,1),1,14),?26,RMSSN,?31,RMUSR,?47,RMQTY,?59,RMSER,?73,$J(RMCUB,7,0) S:$G(RMCO) RMTOCO=RMTOCO+RMCO
|
---|
| 80 | .I 'RMPAT W ?11,"**Note: ",RMCOM,?49,$J(RMONO,4),?54,$J(RMREC,4),?73,$J(RMCUB,7,0) I RMCOM["Returned" S:$G(RMCO) RMTOCO=RMTOCO+RMCO
|
---|
| 81 | .S RMPRFLG=1
|
---|
| 82 | .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
|
---|
| 83 | .I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 S RMPRFLG=1
|
---|
| 84 | Q
|
---|
| 85 | ;
|
---|
| 86 | HEAD W !,"*** ISSUE and STOCK CONTROL RECORD - PROSTHETICS STOCK ITEMS ***",?65,"Page: ",RMPAGE,!,?30,"station: ",$E($P($G(^DIC(4,RMPR("STA"),0)),U,1),1,20)
|
---|
| 87 | N X,% S Y=RMPRBDT D DD^%DT W !,Y," to " S Y=RMPREDT D DD^%DT W Y
|
---|
| 88 | S RMPAGE=RMPAGE+1
|
---|
| 89 | Q
|
---|
| 90 | ;
|
---|
| 91 | IHEAD S RMDAHC=$O(^RMPR(661.1,"B",R0,0))
|
---|
| 92 | S RMITEM=$E(RMITEM,1,26)
|
---|
| 93 | W !,"HCPCS: ",R0,?16,"Item: ",R1
|
---|
| 94 | S RMI=1
|
---|
| 95 | Q
|
---|
| 96 | ;
|
---|
| 97 | HEAD1 ;write heading
|
---|
| 98 | 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
|
---|
| 99 | W !,RMPR("L")
|
---|
| 100 | W !,?44,"QTY",?50,"QTY",?55,"QTY",?63,"SERIAL"
|
---|
| 101 | W !," DATE",?9,"PATIENT",?26,"SSN",?31,"USER",?44,"ISSUE",?50,"ORDR",?55,"REC",?63,"NUMBER",?73,"BALANCE"
|
---|
| 102 | W !," ----",?9,"-------",?26,"---",?31,"----",?44,"-----",?50,"----",?55,"---",?63,"------",?73,"-------"
|
---|
| 103 | S RMPRFLG=1
|
---|
| 104 | Q
|
---|
| 105 | ;
|
---|
| 106 | HTOTAL ;
|
---|
| 107 | I RMFH,'RMPREND W !!,?23,"*** Dollar Value of HCPCS Issued",?60,"=",?62,$J(RMTOCOH,11,2)
|
---|
| 108 | S (RMTOCOH,RMFH)=0
|
---|
| 109 | Q
|
---|
| 110 | ;
|
---|
| 111 | ITOTAL ;
|
---|
| 112 | I RMFI,'RMPREND W !,?42,"--------------------------------------",!,?23,"*** Dollar Value of Item Issued",?60,"=",?62,$J(RMTOCO,11,2)
|
---|
| 113 | S RMTOCOH=RMTOCOH+RMTOCO,(RMTOCO,RMCO,RMFI)=0
|
---|
| 114 | Q
|
---|
| 115 | ;
|
---|
| 116 | NONE ;nothing to report.
|
---|
| 117 | W !,RMPR("L"),!,"No Item Statistics for HCPCS: ",RQ,"...for this date range !!!"
|
---|
| 118 | Q
|
---|
| 119 | NONEALL W !!,"NO DATA AT THIS DATE RANGE!!!!"
|
---|
| 120 | Q
|
---|