RMPR5HQ6 ;HCIOFO/ODJ - USAGE CALCULATION, LOCAL REPORT ; 20 SEP 00 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996 Q ; ;Vars. required... ;RMPRSDT ;RMPREDT CALC N KEYS,EOF,CHNG,OLD,GTOT,LTOT,HTOT,ITOT,INVREC N X1,X2,DAYS,I,DAYAV,X,QOHU,QOHN D INIT(.KEYS,.EOF,.CHNG) I EOF G CALCX S X2=RMPRSDT,X1=RMPREDT D ^%DTC S DAYS=X+1 F Q:EOF D . S:CHNG("STATION") OLD("STATION")=KEYS("STATION") . S:CHNG("NPPD_GROUP") OLD("NPPD_GROUP")=KEYS("NPPD_GROUP"),GTOT="" . S:CHNG("NPPD_LINE") OLD("NPPD_LINE")=KEYS("NPPD_LINE"),LTOT="" . S:CHNG("HCPC_CODE") OLD("HCPC")=KEYS("HCPC"),HTOT="" . I CHNG("HCPC_ITEM") D .. S OLD("HCPC_ITEM")=KEYS("HCPC_ITEM") .. D RDITEM(.KEYS,.ITOT) ;get current quantity on hand and value .. S QOHU=+$P(ITOT,"^",8),QOHN=+$P(ITOT,"^",9) .. Q . D RDINV(.KEYS,.INVREC) ;read inventory . I INVREC("SOURCE")="C" D .. S $P(ITOT,"^",2)=$P(ITOT,"^",2)+INVREC("QTY") ;commercial issue .. S $P(ITOT,"^",5)=$P(ITOT,"^",5)+INVREC("ISSUE COST") .. Q . E D .. S $P(ITOT,"^",1)=$P(ITOT,"^",1)+INVREC("QTY") ;VA issue .. S $P(ITOT,"^",4)=$P(ITOT,"^",4)+INVREC("ISSUE COST") .. Q . D NXINV(.KEYS,.EOF,.CHNG) ;next inventory record in ^TMP . I CHNG("HCPC_ITEM")!EOF D .. S DAYAV=$P(ITOT,"^",2)/DAYS .. S $P(ITOT,"^",6)=DAYAV .. S:DAYAV $P(ITOT,"^",7)=QOHN/DAYAV .. S DAYAV=$P(ITOT,"^",1)/DAYS .. S $P(ITOT,"^",12)=DAYAV .. S:DAYAV $P(ITOT,"^",13)=QOHU/DAYAV .. D UPITEM(.OLD,ITOT) ;update Item totals in ^TMP .. F I=1:1:5,8:1:11 S $P(HTOT,"^",I)=$P(ITOT,"^",I)+$P(HTOT,"^",I) .. Q . I CHNG("HCPC_CODE")!EOF D .. S DAYAV=$P(HTOT,"^",2)/DAYS .. S $P(HTOT,"^",6)=DAYAV .. S:DAYAV $P(HTOT,"^",7)=$P(HTOT,"^",9)/DAYAV .. S DAYAV=$P(HTOT,"^",1)/DAYS .. S $P(HTOT,"^",12)=DAYAV .. S:DAYAV $P(HTOT,"^",13)=$P(HTOT,"^",8)/DAYAV .. D UPHCPC(.OLD,HTOT) ;update HCPC totals in ^TMP .. F I=1:1:5,8:1:11 S $P(LTOT,"^",I)=$P(HTOT,"^",I)+$P(LTOT,"^",I) .. Q . I CHNG("NPPD_LINE")!EOF D .. S DAYAV=$P(LTOT,"^",2)/DAYS .. S $P(LTOT,"^",6)=DAYAV .. S:DAYAV $P(LTOT,"^",7)=$P(LTOT,"^",9)/DAYAV .. S DAYAV=$P(LTOT,"^",1)/DAYS .. S $P(LTOT,"^",12)=DAYAV .. S:DAYAV $P(LTOT,"^",13)=$P(LTOT,"^",8)/DAYAV .. D UPLIN(.OLD,LTOT) ;update NPPD line totals .. S $P(GTOT,"^",4)=$P(LTOT,"^",4)+$P(GTOT,"^",4) .. S $P(GTOT,"^",5)=$P(LTOT,"^",5)+$P(GTOT,"^",5) .. S $P(GTOT,"^",10)=$P(LTOT,"^",10)+$P(GTOT,"^",10) .. S $P(GTOT,"^",11)=$P(LTOT,"^",11)+$P(GTOT,"^",11) .. Q . I CHNG("NPPD_GROUP")!EOF D .. D UPGRP(.OLD,GTOT) ;update NPPD group totals .. Q . Q CALCX Q ; ; Read inventory rec RDINV(PRIKEY,INVREC) ; N INVIEN,S,TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION S TNAM="RMPR5" S INVIEN=PRIKEY("INVENTORY_IEN") I INVIEN="" S INVREC("QTY")=0,INVREC("SOURCE")="",INVREC("ISSUE COST")=0 Q S STATION=PRIKEY("STATION") S NPGRP=PRIKEY("NPPD_GROUP") S NPLIN=PRIKEY("NPPD_LINE") S HCPC=PRIKEY("HCPC") S ITEM=PRIKEY("HCPC_ITEM") S S=$G(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,INVIEN)) K INVREC S INVREC("QTY")=$P(S,"^",1) S INVREC("SOURCE")=$P(S,"^",3) S INVREC("ISSUE COST")=$P(S,"^",2) Q RDITEM(PRIKEY,MYSTR) ; N TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION S TNAM="RMPR5" S STATION=PRIKEY("STATION") S NPGRP=PRIKEY("NPPD_GROUP") S NPLIN=PRIKEY("NPPD_LINE") S HCPC=PRIKEY("HCPC") S ITEM=PRIKEY("HCPC_ITEM") S MYSTR=$G(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM)) Q ; ; Get next inventory record NXINV(RMPRKEY,RMPREOF,RMPRCHNG) ; N TNAM,NPGRP,NPLIN,HCPC,ITEM,INVIEN,STATION S TNAM="RMPR5" S STATION=RMPRKEY("STATION") S NPGRP=RMPRKEY("NPPD_GROUP") S NPLIN=RMPRKEY("NPPD_LINE") S HCPC=RMPRKEY("HCPC") S ITEM=RMPRKEY("HCPC_ITEM") S INVIEN=RMPRKEY("INVENTORY_IEN") S RMPREOF=0 S RMPRCHNG("STATION")=0 S RMPRCHNG("NPPD_GROUP")=0,RMPRCHNG("NPPD_LINE")=0,RMPRCHNG("HCPC_CODE")=0,RMPRCHNG("HCPC_ITEM")=0 S INVIEN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,INVIEN)) S:INVIEN="" ITEM=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM)) S:ITEM="" HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC)) S:HCPC="" NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN)) S:NPLIN="" NPGRP=$O(^TMP($J,TNAM,STATION,NPGRP)) S:NPGRP="" STATION=$O(^TMP($J,TNAM,STATION)) I STATION=""!(STATION="Z") S RMPREOF=1,RMPRCHNG("INVENTORY_IEN")=0 G NXINVX S:NPGRP="" NPGRP=$O(^TMP($J,TNAM,STATION,"")),RMPRCHNG("STATION")=1 S:NPLIN="" NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,"")),RMPRCHNG("NPPD_GROUP")=1 S:HCPC="" HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,"")),RMPRCHNG("NPPD_LINE")=1 S:ITEM="" ITEM=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,"")),RMPRCHNG("HCPC_CODE")=1 S:INVIEN="" INVIEN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,"")),RMPRCHNG("HCPC_ITEM")=1 S RMPRCHNG("INVENTORY_IEN")=1 S RMPRKEY("STATION")=STATION S RMPRKEY("NPPD_GROUP")=NPGRP S RMPRKEY("NPPD_LINE")=NPLIN S RMPRKEY("HCPC")=HCPC S RMPRKEY("HCPC_CODE")=$P(HCPC,"/",1) S RMPRKEY("HCPC_IEN")=$P(HCPC,"/",2) S RMPRKEY("HCPC_ITEM")=ITEM S RMPRKEY("INVENTORY_IEN")=INVIEN NXINVX Q ; ; Init. TMP array keys INIT(RMPRKEY,RMPREOF,RMPRCHNG) ; N TNAM,NPGRP,NPLIN,HCPC,ITEM,INVIEN,STATION S TNAM="RMPR5" K RMPRKEY S RMPREOF=0 S RMPRCHNG("STATION")=0,RMPRCHNG("NPPD_GROUP")=0,RMPRCHNG("NPPD_LINE")=0 S RMPRCHNG("HCPC_CODE")=0,RMPRCHNG("HCPC_ITEM")=0,RMPRCHNG("INVENTORY_IEN")=0 S STATION=$O(^TMP($J,TNAM,"")) I STATION=""!(STATION="Z") S RMPREOF=1 G INITX S RMPRCHNG("STATION")=1,RMPRCHNG("NPPD_GROUP")=1,RMPRCHNG("NPPD_LINE")=1 S RMPRCHNG("HCPC_CODE")=1,RMPRCHNG("HCPC_ITEM")=1,RMPRCHNG("INVENTORY_IEN")=1 S NPGRP=$O(^TMP($J,TNAM,STATION,"")) S NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,"")) S HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,"")) S ITEM=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,"")) S INVIEN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,"")) S RMPRKEY("STATION")=STATION S RMPRKEY("NPPD_GROUP")=NPGRP S RMPRKEY("NPPD_LINE")=NPLIN S RMPRKEY("HCPC")=HCPC S RMPRKEY("HCPC_CODE")=$P(HCPC,"/",1) S RMPRKEY("HCPC_IEN")=$P(HCPC,"/",2) S RMPRKEY("HCPC_ITEM")=ITEM S RMPRKEY("INVENTORY_IEN")=INVIEN INITX Q ; ; ^TMP updates UPGRP(PRIKEY,MYSTR) ; N TNAM,NPGRP,STATION S TNAM="RMPR5" S STATION=PRIKEY("STATION") S NPGRP=PRIKEY("NPPD_GROUP") S ^TMP($J,TNAM,STATION,NPGRP)=MYSTR Q UPLIN(PRIKEY,MYSTR) ; N TNAM,NPGRP,NPLIN,STATION S TNAM="RMPR5" S STATION=PRIKEY("STATION") S NPGRP=PRIKEY("NPPD_GROUP") S NPLIN=PRIKEY("NPPD_LINE") S ^TMP($J,TNAM,STATION,NPGRP,NPLIN)=MYSTR Q UPHCPC(PRIKEY,MYSTR) ; N TNAM,NPGRP,NPLIN,HCPC,STATION S TNAM="RMPR5" S STATION=PRIKEY("STATION") S NPGRP=PRIKEY("NPPD_GROUP") S NPLIN=PRIKEY("NPPD_LINE") S HCPC=PRIKEY("HCPC") S ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC)=MYSTR Q UPITEM(PRIKEY,MYSTR) ; N TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION S TNAM="RMPR5" S STATION=PRIKEY("STATION") S NPGRP=PRIKEY("NPPD_GROUP") S NPLIN=PRIKEY("NPPD_LINE") S HCPC=PRIKEY("HCPC") S ITEM=PRIKEY("HCPC_ITEM") S ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM)=MYSTR Q