source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQ6.m@ 1800

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