- 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 Feb 18, 2025@23:59:30 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