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

RMPR5HQ6.m

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