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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR5HQ6 6985 printed Sep 23, 2025@20:09:11 Page 2
RMPR5HQ6 ;HCIOFO/ODJ - USAGE CALCULATION, LOCAL REPORT ; 20 SEP 00
+1 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;Vars. required...
+5 ;RMPRSDT
+6 ;RMPREDT
CALC NEW KEYS,EOF,CHNG,OLD,GTOT,LTOT,HTOT,ITOT,INVREC
+1 NEW X1,X2,DAYS,I,DAYAV,X,QOHU,QOHN
+2 DO INIT(.KEYS,.EOF,.CHNG)
IF EOF
GOTO CALCX
+3 SET X2=RMPRSDT
SET X1=RMPREDT
DO ^%DTC
SET DAYS=X+1
+4 FOR
if EOF
QUIT
Begin DoDot:1
+5 if CHNG("STATION")
SET OLD("STATION")=KEYS("STATION")
+6 if CHNG("NPPD_GROUP")
SET OLD("NPPD_GROUP")=KEYS("NPPD_GROUP")
SET GTOT=""
+7 if CHNG("NPPD_LINE")
SET OLD("NPPD_LINE")=KEYS("NPPD_LINE")
SET LTOT=""
+8 if CHNG("HCPC_CODE")
SET OLD("HCPC")=KEYS("HCPC")
SET HTOT=""
+9 IF CHNG("HCPC_ITEM")
Begin DoDot:2
+10 SET OLD("HCPC_ITEM")=KEYS("HCPC_ITEM")
+11 ;get current quantity on hand and value
DO RDITEM(.KEYS,.ITOT)
+12 SET QOHU=+$PIECE(ITOT,"^",8)
SET QOHN=+$PIECE(ITOT,"^",9)
+13 QUIT
End DoDot:2
+14 ;read inventory
DO RDINV(.KEYS,.INVREC)
+15 IF INVREC("SOURCE")="C"
Begin DoDot:2
+16 ;commercial issue
SET $PIECE(ITOT,"^",2)=$PIECE(ITOT,"^",2)+INVREC("QTY")
+17 SET $PIECE(ITOT,"^",5)=$PIECE(ITOT,"^",5)+INVREC("ISSUE COST")
+18 QUIT
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 ;VA issue
SET $PIECE(ITOT,"^",1)=$PIECE(ITOT,"^",1)+INVREC("QTY")
+21 SET $PIECE(ITOT,"^",4)=$PIECE(ITOT,"^",4)+INVREC("ISSUE COST")
+22 QUIT
End DoDot:2
+23 ;next inventory record in ^TMP
DO NXINV(.KEYS,.EOF,.CHNG)
+24 IF CHNG("HCPC_ITEM")!EOF
Begin DoDot:2
+25 SET DAYAV=$PIECE(ITOT,"^",2)/DAYS
+26 SET $PIECE(ITOT,"^",6)=DAYAV
+27 if DAYAV
SET $PIECE(ITOT,"^",7)=QOHN/DAYAV
+28 SET DAYAV=$PIECE(ITOT,"^",1)/DAYS
+29 SET $PIECE(ITOT,"^",12)=DAYAV
+30 if DAYAV
SET $PIECE(ITOT,"^",13)=QOHU/DAYAV
+31 ;update Item totals in ^TMP
DO UPITEM(.OLD,ITOT)
+32 FOR I=1:1:5,8:1:11
SET $PIECE(HTOT,"^",I)=$PIECE(ITOT,"^",I)+$PIECE(HTOT,"^",I)
+33 QUIT
End DoDot:2
+34 IF CHNG("HCPC_CODE")!EOF
Begin DoDot:2
+35 SET DAYAV=$PIECE(HTOT,"^",2)/DAYS
+36 SET $PIECE(HTOT,"^",6)=DAYAV
+37 if DAYAV
SET $PIECE(HTOT,"^",7)=$PIECE(HTOT,"^",9)/DAYAV
+38 SET DAYAV=$PIECE(HTOT,"^",1)/DAYS
+39 SET $PIECE(HTOT,"^",12)=DAYAV
+40 if DAYAV
SET $PIECE(HTOT,"^",13)=$PIECE(HTOT,"^",8)/DAYAV
+41 ;update HCPC totals in ^TMP
DO UPHCPC(.OLD,HTOT)
+42 FOR I=1:1:5,8:1:11
SET $PIECE(LTOT,"^",I)=$PIECE(HTOT,"^",I)+$PIECE(LTOT,"^",I)
+43 QUIT
End DoDot:2
+44 IF CHNG("NPPD_LINE")!EOF
Begin DoDot:2
+45 SET DAYAV=$PIECE(LTOT,"^",2)/DAYS
+46 SET $PIECE(LTOT,"^",6)=DAYAV
+47 if DAYAV
SET $PIECE(LTOT,"^",7)=$PIECE(LTOT,"^",9)/DAYAV
+48 SET DAYAV=$PIECE(LTOT,"^",1)/DAYS
+49 SET $PIECE(LTOT,"^",12)=DAYAV
+50 if DAYAV
SET $PIECE(LTOT,"^",13)=$PIECE(LTOT,"^",8)/DAYAV
+51 ;update NPPD line totals
DO UPLIN(.OLD,LTOT)
+52 SET $PIECE(GTOT,"^",4)=$PIECE(LTOT,"^",4)+$PIECE(GTOT,"^",4)
+53 SET $PIECE(GTOT,"^",5)=$PIECE(LTOT,"^",5)+$PIECE(GTOT,"^",5)
+54 SET $PIECE(GTOT,"^",10)=$PIECE(LTOT,"^",10)+$PIECE(GTOT,"^",10)
+55 SET $PIECE(GTOT,"^",11)=$PIECE(LTOT,"^",11)+$PIECE(GTOT,"^",11)
+56 QUIT
End DoDot:2
+57 IF CHNG("NPPD_GROUP")!EOF
Begin DoDot:2
+58 ;update NPPD group totals
DO UPGRP(.OLD,GTOT)
+59 QUIT
End DoDot:2
+60 QUIT
End DoDot:1
CALCX QUIT
+1 ;
+2 ; Read inventory rec
RDINV(PRIKEY,INVREC) ;
+1 NEW INVIEN,S,TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION
+2 SET TNAM="RMPR5"
+3 SET INVIEN=PRIKEY("INVENTORY_IEN")
+4 IF INVIEN=""
SET INVREC("QTY")=0
SET INVREC("SOURCE")=""
SET INVREC("ISSUE COST")=0
QUIT
+5 SET STATION=PRIKEY("STATION")
+6 SET NPGRP=PRIKEY("NPPD_GROUP")
+7 SET NPLIN=PRIKEY("NPPD_LINE")
+8 SET HCPC=PRIKEY("HCPC")
+9 SET ITEM=PRIKEY("HCPC_ITEM")
+10 SET S=$GET(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,INVIEN))
+11 KILL INVREC
+12 SET INVREC("QTY")=$PIECE(S,"^",1)
+13 SET INVREC("SOURCE")=$PIECE(S,"^",3)
+14 SET INVREC("ISSUE COST")=$PIECE(S,"^",2)
+15 QUIT
RDITEM(PRIKEY,MYSTR) ;
+1 NEW TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION
+2 SET TNAM="RMPR5"
+3 SET STATION=PRIKEY("STATION")
+4 SET NPGRP=PRIKEY("NPPD_GROUP")
+5 SET NPLIN=PRIKEY("NPPD_LINE")
+6 SET HCPC=PRIKEY("HCPC")
+7 SET ITEM=PRIKEY("HCPC_ITEM")
+8 SET MYSTR=$GET(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM))
+9 QUIT
+10 ;
+11 ; Get next inventory record
NXINV(RMPRKEY,RMPREOF,RMPRCHNG) ;
+1 NEW TNAM,NPGRP,NPLIN,HCPC,ITEM,INVIEN,STATION
+2 SET TNAM="RMPR5"
+3 SET STATION=RMPRKEY("STATION")
+4 SET NPGRP=RMPRKEY("NPPD_GROUP")
+5 SET NPLIN=RMPRKEY("NPPD_LINE")
+6 SET HCPC=RMPRKEY("HCPC")
+7 SET ITEM=RMPRKEY("HCPC_ITEM")
+8 SET INVIEN=RMPRKEY("INVENTORY_IEN")
+9 SET RMPREOF=0
+10 SET RMPRCHNG("STATION")=0
+11 SET RMPRCHNG("NPPD_GROUP")=0
SET RMPRCHNG("NPPD_LINE")=0
SET RMPRCHNG("HCPC_CODE")=0
SET RMPRCHNG("HCPC_ITEM")=0
+12 SET INVIEN=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,INVIEN))
+13 if INVIEN=""
SET ITEM=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM))
+14 if ITEM=""
SET HCPC=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC))
+15 if HCPC=""
SET NPLIN=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN))
+16 if NPLIN=""
SET NPGRP=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP))
+17 if NPGRP=""
SET STATION=$ORDER(^TMP($JOB,TNAM,STATION))
+18 IF STATION=""!(STATION="Z")
SET RMPREOF=1
SET RMPRCHNG("INVENTORY_IEN")=0
GOTO NXINVX
+19 if NPGRP=""
SET NPGRP=$ORDER(^TMP($JOB,TNAM,STATION,""))
SET RMPRCHNG("STATION")=1
+20 if NPLIN=""
SET NPLIN=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,""))
SET RMPRCHNG("NPPD_GROUP")=1
+21 if HCPC=""
SET HCPC=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,""))
SET RMPRCHNG("NPPD_LINE")=1
+22 if ITEM=""
SET ITEM=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,""))
SET RMPRCHNG("HCPC_CODE")=1
+23 if INVIEN=""
SET INVIEN=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,""))
SET RMPRCHNG("HCPC_ITEM")=1
+24 SET RMPRCHNG("INVENTORY_IEN")=1
+25 SET RMPRKEY("STATION")=STATION
+26 SET RMPRKEY("NPPD_GROUP")=NPGRP
+27 SET RMPRKEY("NPPD_LINE")=NPLIN
+28 SET RMPRKEY("HCPC")=HCPC
+29 SET RMPRKEY("HCPC_CODE")=$PIECE(HCPC,"/",1)
+30 SET RMPRKEY("HCPC_IEN")=$PIECE(HCPC,"/",2)
+31 SET RMPRKEY("HCPC_ITEM")=ITEM
+32 SET RMPRKEY("INVENTORY_IEN")=INVIEN
NXINVX QUIT
+1 ;
+2 ; Init. TMP array keys
INIT(RMPRKEY,RMPREOF,RMPRCHNG) ;
+1 NEW TNAM,NPGRP,NPLIN,HCPC,ITEM,INVIEN,STATION
+2 SET TNAM="RMPR5"
+3 KILL RMPRKEY
+4 SET RMPREOF=0
+5 SET RMPRCHNG("STATION")=0
SET RMPRCHNG("NPPD_GROUP")=0
SET RMPRCHNG("NPPD_LINE")=0
+6 SET RMPRCHNG("HCPC_CODE")=0
SET RMPRCHNG("HCPC_ITEM")=0
SET RMPRCHNG("INVENTORY_IEN")=0
+7 SET STATION=$ORDER(^TMP($JOB,TNAM,""))
+8 IF STATION=""!(STATION="Z")
SET RMPREOF=1
GOTO INITX
+9 SET RMPRCHNG("STATION")=1
SET RMPRCHNG("NPPD_GROUP")=1
SET RMPRCHNG("NPPD_LINE")=1
+10 SET RMPRCHNG("HCPC_CODE")=1
SET RMPRCHNG("HCPC_ITEM")=1
SET RMPRCHNG("INVENTORY_IEN")=1
+11 SET NPGRP=$ORDER(^TMP($JOB,TNAM,STATION,""))
+12 SET NPLIN=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,""))
+13 SET HCPC=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,""))
+14 SET ITEM=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,""))
+15 SET INVIEN=$ORDER(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,""))
+16 SET RMPRKEY("STATION")=STATION
+17 SET RMPRKEY("NPPD_GROUP")=NPGRP
+18 SET RMPRKEY("NPPD_LINE")=NPLIN
+19 SET RMPRKEY("HCPC")=HCPC
+20 SET RMPRKEY("HCPC_CODE")=$PIECE(HCPC,"/",1)
+21 SET RMPRKEY("HCPC_IEN")=$PIECE(HCPC,"/",2)
+22 SET RMPRKEY("HCPC_ITEM")=ITEM
+23 SET RMPRKEY("INVENTORY_IEN")=INVIEN
INITX QUIT
+1 ;
+2 ; ^TMP updates
UPGRP(PRIKEY,MYSTR) ;
+1 NEW TNAM,NPGRP,STATION
+2 SET TNAM="RMPR5"
+3 SET STATION=PRIKEY("STATION")
+4 SET NPGRP=PRIKEY("NPPD_GROUP")
+5 SET ^TMP($JOB,TNAM,STATION,NPGRP)=MYSTR
+6 QUIT
UPLIN(PRIKEY,MYSTR) ;
+1 NEW TNAM,NPGRP,NPLIN,STATION
+2 SET TNAM="RMPR5"
+3 SET STATION=PRIKEY("STATION")
+4 SET NPGRP=PRIKEY("NPPD_GROUP")
+5 SET NPLIN=PRIKEY("NPPD_LINE")
+6 SET ^TMP($JOB,TNAM,STATION,NPGRP,NPLIN)=MYSTR
+7 QUIT
UPHCPC(PRIKEY,MYSTR) ;
+1 NEW TNAM,NPGRP,NPLIN,HCPC,STATION
+2 SET TNAM="RMPR5"
+3 SET STATION=PRIKEY("STATION")
+4 SET NPGRP=PRIKEY("NPPD_GROUP")
+5 SET NPLIN=PRIKEY("NPPD_LINE")
+6 SET HCPC=PRIKEY("HCPC")
+7 SET ^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC)=MYSTR
+8 QUIT
UPITEM(PRIKEY,MYSTR) ;
+1 NEW TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION
+2 SET TNAM="RMPR5"
+3 SET STATION=PRIKEY("STATION")
+4 SET NPGRP=PRIKEY("NPPD_GROUP")
+5 SET NPLIN=PRIKEY("NPPD_LINE")
+6 SET HCPC=PRIKEY("HCPC")
+7 SET ITEM=PRIKEY("HCPC_ITEM")
+8 SET ^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM)=MYSTR
+9 QUIT
