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

RMPRPI10.m

Go to the documentation of this file.
  1. RMPRPI10 ;HIN/RVD-PRINT ITEM DETAIL OVER 30 DAYS ;3/8/05 11:40
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. ; DBIA #10090 - Read Access to entire file #4.
  1. ; DBIA #10096 - Access to all %ZOSF nodes.
  1. ;
  1. K DIC,DIR,%DT
  1. D DIV4^RMPRSIT I $D(Y),(Y<0) Q
  1. S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
  1. ;
  1. EN K RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS
  1. S DIC="^RMPR(661.5,",DIC(0)="AEQ"
  1. S DIC("S")="I $P(^RMPR(661.5,+Y,0),U,2)=RMPR(""STA"")"
  1. ;
  1. EN1 R !!,"Enter 'ALL' for all Locations or 'RETURN' to select individual Locations: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1
  1. G:RMENTER["?" EN1
  1. S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y
  1. I RMENTER="ALL" S RMPRI="*" G CONT
  1. W ! F RML=1:1 S DIC("A")="Select Location "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D
  1. .S RMLOCI=+Y
  1. .I $D(RMPRI(RMLOCI)) W $C(7)," ??",?40,"..Duplicate Location" S RML=RML-1 Q
  1. .S RMPRI(RMLOCI)=""
  1. ;
  1. CONT ;
  1. K DIR
  1. S DIR("B")="NEW Items",DIR("A")="Enter a SOURCE Creteria"
  1. S DIR(0)="S^V:OLD Items;C:NEW Items"
  1. D ^DIR G:$D(DUOUT)!$D(DIRUT)!$D(DTOUT) EXIT1
  1. S RE=Y K DIR
  1. ;
  1. DT ;
  1. W ! S %DT("A")="Beginning Date: ",%DT="AEPX",%DT("B")="T-30" D ^%DT S RMB=Y G:Y<0 EXIT1
  1. ENDATE S %DT("A")="Ending Date: ",%DT="AEX",%DT("B")="TODAY" D ^%DT G:Y<0 EXIT1 I RMB>Y W !,$C(7),"Invalid Date Range Selection!!" G ENDATE
  1. S RME=Y
  1. ;
  1. G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
  1. I '$D(IO("Q")) U IO G PRINT
  1. K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY"
  1. S ZTRTN="PRINT^RMPRPI10",ZTIO=ION,ZTSAVE("RMPRI(")=""
  1. S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")=""
  1. S ZTSAVE("RE")="",ZTSAVE("RMPRI")=""
  1. S ZTSAVE("RME")="",ZTSAVE("RMB")=""
  1. D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
  1. ;
  1. PRINT I $E(IOST)["C" W !!,"Processing report....."
  1. ;
  1. ;call API
  1. ;input variables:
  1. ; RM = any subscript to be used
  1. ; RS = rmpr("sta")
  1. ; RE = source (V or C)
  1. ; RMPRI = rmpri(location array; '*' for all location )
  1. ; RMB = beginning date
  1. ; RME = ending date
  1. ;
  1. S X1=RME,X2=RMB
  1. D ^%DTC S RMCALDAY=X+1
  1. S Y=RMB D DD^%DT S RMBDAT=Y S Y=RME D DD^%DT S RMEDAT=Y
  1. D NOW^%DTC S Y=% X ^DD("DD") S RMDAT=Y
  1. S RSOU=$S(RE="V":"USED",RE="C":"NEW",1:"")
  1. S RS=RMPR("STA"),RM="RM"
  1. ;
  1. S RMCHK=$$LOC^RMPRPI07(RM,RS,.RMPRI,RE,RMB,RME)
  1. I RMCHK W !!,"ERROR NUMBER = ",RMCHK,!,"***Error in API RMPRPI07 !!!!",!! G EXIT
  1. ;
  1. S RMPAGE=1,RMPREND=0
  1. I '$D(^TMP($J,"RM")) D NONE G EXIT
  1. W:$E(IOST)["C" @IOF
  1. D HEAD,WRI
  1. G EXIT
  1. ;
  1. ;write/print report
  1. ;rl = Location
  1. ;rh = HCPCS
  1. ;j = Item
  1. ;k = Item description
  1. ;
  1. ;
  1. WRI S RL=""
  1. F S RL=$O(^TMP($J,"RM",RL)) Q:(RL="")!(RMPREND) K RMPRFLG S RH="" F S RH=$O(^TMP($J,"RM",RL,RH)) Q:(RH="")!(RMPREND) S J="" D
  1. .F S J=$O(^TMP($J,"RM",RL,RH,J)) Q:(J="")!(RMPREND) S K="" F S K=$O(^TMP($J,"RM",RL,RH,J,K)) Q:(K="")!(RMPREND) D
  1. ..S RM3=^TMP($J,"RM",RL,RH,J,K)
  1. ..S RMIT=K
  1. ..S RMQTY=$P(RM3,U,1)
  1. ..S RMCOS=$P(RM3,U,2)
  1. ..S RMDAU=RMQTY/RMCALDAY
  1. ..S RMDOH=""
  1. ..S RMSOH=$P(RM3,U,5)
  1. ..S:+RMDAU RMDOH=$J(RMSOH/RMDAU,0,1) S:RMDOH>999 RMDOH=">999"
  1. ..I 'RMDAU S RMDOH=">"_RMCALDAY
  1. ..S RMDAU=$J(RMDAU,0,3)
  1. ..S RMTDV=$P(RM3,U,6)
  1. ..I '$D(RMPRFLG) D HEAD1
  1. ..S RMIDE=$E(J,1,13)
  1. ..W !,RH_"-"_RMIT,?10,RMIDE,?24,$J(RMQTY,4),?29,$J($FN(RMCOS,",",2),9),?42,RMDAU,?54,$J(RMDOH,4)
  1. ..W ?61,$J(RMSOH,5),?70,$J($FN(RMTDV,",",2),10)
  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 Q
  1. W !,RMPR("L"),!,"<End of Report>"
  1. Q
  1. ;
  1. W !,"Station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20),?30,"Run Date: ",RMDAT
  1. W ?68,"PAGE: ",RMPAGE
  1. W !,RMBDAT," to ",RMEDAT,?30,"[ ",RMCALDAY," calendar days ]"
  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 !,"Location: ",$P($G(^RMPR(661.5,RL,0)),"^",1)
  1. W !,?25,"QTY",?35,"$",?41,"DAYS AVE"
  1. W ?54,"DAYS",?62,"STOCK",?72,"TOTAL $"
  1. W !,"HCPCS",?10,"ITEM",?24,"ISSUE",?33,"VALUE"
  1. W ?40,"USAGE RATE",?52,"ON-HAND",?61,"ON-HAND",?70,"VAL ON-HND"
  1. W !,"-----",?10,"----",?24,"-----",?33,"-----"
  1. W ?40,"----------",?52,"-------",?61,"-------",?70,"----------"
  1. S RMPRFLG=1
  1. Q
  1. ;
  1. EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
  1. ;
  1. EXIT1 D ^%ZISC
  1. N RMPR,RMPRSITE D KILL^XUSCLEAN
  1. K ^TMP($J)
  1. Q
  1. ;
  1. NONE ;
  1. W:$E(IOST)["C" @IOF
  1. D HEAD
  1. W !,RMPR("L")
  1. W !!,"NO DATA to print !!!"
  1. Q