PRCPLO2A ;WOIFO/DAP-stock status report (cont) ; 1/26/06 12:00pm
V ;;5.1;IFCAP;**83,98,112**;Oct 20, 2000;Build 2
;Per VHA Directive 2004-038, this routine should not be modified.
;External reference to $$GET1^DIQ(4, is supported by ICR# 10090
; *112 changes by: VMP, Holloway,T.
;
ENT ;*83 Building ^TMP with total result data, totaling logic pulled from PRCPRSS0
N PRCPIN,PRCPIN1,PRCPIN2,PRCPIN3,TOTVAL,TOTCLOS,TOTCLO1,TOTCLO2,SSRIEN
S U="^",STA=PRC("SITE"),INV=PRCP("I")
;
SSR1 ;*98 First Stock Status Report data field set
;
S $P(^TMP($J,"PRCPSSR1",STA,INV),U,1)=STA ;Station #
S DATRN=$$FMTE^XLFDT(DATESTRT)
S DATRN1=$P(DATRN," ",1)_","_$P(DATRN," ",2)
S $P(^TMP($J,"PRCPSSR1",STA,INV),U,2)=DATRN1 ;Date Range
S $P(^TMP($J,"PRCPSSR1",STA,INV),U,3)=INARNG ;Inactivity Range
S $P(^TMP($J,"PRCPSSR1",STA,INV),U,4)=INV ;Inventory Point #
;*83 Retrieve external inventory point name and primary/secondary/
;warehouse indicator
S PRCPIN=$G(^PRCP(445,INV,0))
I PRCPIN'="" S PRCPIN1=$P(PRCPIN,"^",1),PRCPIN2=$P(PRCPIN1,"-",2,99)
I PRCPIN'="" S PRCPIN3=$P(PRCPIN,"^",3)
I PRCPIN="" S PRCPIN2="",PRCPIN3=""
S PRCPIN2=$TR(PRCPIN2,"*","|") ; Needed due to "*" delimiter
S $P(^TMP($J,"PRCPSSR1",STA,INV),U,5)=PRCPIN2 ;Inventory Point Name
S $P(^TMP($J,"PRCPSSR1",STA,INV),U,6)=PRCPIN3 ;P/S/W Indicator
;
S PRCPDX=$TR(^TMP($J,"PRCPSSR1",STA,INV),"^","*"),DR="3///"_PRCPDX
D FILE
;
SSR2 ;*98 Second Stock Status Report data field set
;
S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,1,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+%
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,1)=TOTOPEN ;Std. Open Balance Total $
S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,2,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+%
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,2)=TOTOPEN ;ODI Open Balance Total $
S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,3,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+%
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,3)=TOTOPEN ;All Open Balance Total $
;
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,4)=+$G(^TMP($J,1,"REC","TOTAL"))
;Std. Receipts Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,5)=+$G(^TMP($J,2,"REC","TOTAL"))
;ODI Receipts Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,6)=+$G(^TMP($J,3,"REC","TOTAL"))
;All Receipts Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,7)=+$G(^TMP($J,1,"ISS","TOTAL"))
;Std. Usages Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,8)=+$G(^TMP($J,2,"ISS","TOTAL"))
;ODI Usages Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,9)=+$G(^TMP($J,3,"ISS","TOTAL"))
;All Usages Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,10)=+$G(^TMP($J,1,"ADJ","TOTAL"))
;Std. Adjustments Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,11)=+$G(^TMP($J,2,"ADJ","TOTAL"))
;ODI Adjustments Total $
S $P(^TMP($J,"PRCPSSR2",STA,INV),U,12)=+$G(^TMP($J,3,"ADJ","TOTAL"))
;All Adjustments Total $
;
S PRCPDX=$TR(^TMP($J,"PRCPSSR2",STA,INV),"^","*"),DR="4///"_PRCPDX
D FILE
;
SSR3 ;*98 Third Stock Status Report data field set
;
S TOTCLOS=0
S TOTCLOS=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,1)+$G(^TMP($J,1,"REC","TOTAL"))
S TOTCLOS=TOTCLOS+$G(^TMP($J,1,"ISS","TOTAL"))+$G(^TMP($J,1,"ADJ","TOTAL"))
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,1)=TOTCLOS ;Std. Closing Bal Total $
S TOTCLO1=0
S TOTCLO1=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,2)+$G(^TMP($J,2,"REC","TOTAL"))
S TOTCLO1=TOTCLO1+$G(^TMP($J,2,"ISS","TOTAL"))+$G(^TMP($J,2,"ADJ","TOTAL"))
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,2)=TOTCLO1 ;ODI Closing Bal Total $
S TOTCLO2=0
S TOTCLO2=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,3)+$G(^TMP($J,3,"REC","TOTAL"))
S TOTCLO2=TOTCLO2+$G(^TMP($J,3,"ISS","TOTAL"))+$G(^TMP($J,3,"ADJ","TOTAL"))
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,3)=TOTCLO2 ;All Closing Bal Total $
;
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,4)=+$G(^TMP($J,1,"RECN","TOTAL"))
;# Std. Receipts
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,5)=+$G(^TMP($J,2,"RECN","TOTAL"))
;# ODI Receipts
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,6)=+$G(^TMP($J,3,"RECN","TOTAL"))
;# All Receipts
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,7)=+$G(^TMP($J,1,"ISSN","TOTAL"))
;# Std. Issues
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,8)=+$G(^TMP($J,2,"ISSN","TOTAL"))
;# ODI Issues
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,9)=+$G(^TMP($J,3,"ISSN","TOTAL"))
;# All Issues
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,10)=+$G(^TMP($J,1,"ADJN","TOTAL"))
;# Std. Adjustments
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,11)=+$G(^TMP($J,2,"ADJN","TOTAL"))
;# ODI Adjustments
S $P(^TMP($J,"PRCPSSR3",STA,INV),U,12)=+$G(^TMP($J,3,"ADJN","TOTAL"))
;# All Adjustments
;
S PRCPDX=$TR(^TMP($J,"PRCPSSR3",STA,INV),"^","*"),DR="5///"_PRCPDX
D FILE
;
SSR4 ;*98 Fourth Stock Status Report data field set
;
;*83 Turnover computation logic also pulled from PRCPRSS0
S DAYS=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+$E(DATESTRT,4,5))
I DAYS=28 S %=(17+$E(DATESTRT))_$E(DATESTRT,2,3),DAYS=$S(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28)
;
S %=($G(^TMP($J,1,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLOS:0,1:-%/TOTCLOS)
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,1)=$J(%,0,2)
;Std. Turnover
S %=($G(^TMP($J,2,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO1:0,1:-%/TOTCLO1)
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,2)=$J(%,0,2)
;ODI Turnover
S %=($G(^TMP($J,3,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO2:0,1:-%/TOTCLO2)
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,3)=$J(%,0,2)
;All Turnover
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,4)=+$G(^TMP($J,1,"INACTN","TOTAL"))
;# Std. Inactive
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,5)=+$G(^TMP($J,2,"INACTN","TOTAL"))
;# ODI Inactive
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,6)=+$G(^TMP($J,3,"INACTN","TOTAL"))
;# All Inactive
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,7)=+$G(^TMP($J,1,"INACT","TOTAL"))
;Std Inactive Total $
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,8)=+$G(^TMP($J,2,"INACT","TOTAL"))
;ODI Inactive Total $
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,9)=+$G(^TMP($J,3,"INACT","TOTAL"))
;All Inactive Total $
;
S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"INACT","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL")))
I %="" S %=0
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,10)=$J(%,0,2)
;Std. Inactive %
S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"INACT","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL")))
I %="" S %=0
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,11)=$J(%,0,2)
;ODI Inactive %
S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"INACT","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL")))
I %="" S %=0
S $P(^TMP($J,"PRCPSSR4",STA,INV),U,12)=$J(%,0,2)
;All Inactive %
;
S PRCPDX=$TR(^TMP($J,"PRCPSSR4",STA,INV),"^","*"),DR="6///"_PRCPDX
D FILE
;
SSR5 ;*98 Fifth Stock Status Report data field set
;
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,1)=+$G(^TMP($J,1,"LONGN","TOTAL"))
;# Std. Long Supply
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,2)=+$G(^TMP($J,2,"LONGN","TOTAL"))
;# ODI Long Supply
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,3)=+$G(^TMP($J,3,"LONGN","TOTAL"))
;# All Long Supply
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,4)=+$G(^TMP($J,1,"LONG","TOTAL"))
;Std. Long Supply Total $
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,5)=+$G(^TMP($J,2,"LONG","TOTAL"))
;ODI Long Supply Total $
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,6)=+$G(^TMP($J,3,"LONG","TOTAL"))
;All Long Supply Total $
;
S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"LONG","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL")))
I %="" S %=0
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,7)=$J(%,0,2)
;Std. Long Supply %
S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"LONG","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL")))
I %="" S %=0
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,8)=$J(%,0,2)
;ODI Long Supply %
S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"LONG","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL")))
I %="" S %=0
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,9)=$J(%,0,2)
;All Long Supply %
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,10)=+$G(^TMP($J,1,"CNT","TOTAL"))
;# Std. Items
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,11)=+$G(^TMP($J,2,"CNT","TOTAL"))
;# On-Demand Items
S $P(^TMP($J,"PRCPSSR5",STA,INV),U,12)=+$G(^TMP($J,3,"CNT","TOTAL"))
;# All Items
;
S PRCPDX=$TR(^TMP($J,"PRCPSSR5",STA,INV),"^","*"),DR="7///"_PRCPDX
D FILE
K Y
;
Q
;
;*98 Created filing subroutine
FILE ; Subroutine that creates entries in File #446.7 fields as they
; are created
;
N PRCPDR,PRCPSNM,PRCPDA,PRCPDX,X,Y
S PRCPDR=DR
S SSRIEN=STA_INV
S DIC="^PRCP(446.7,",DIC(0)="L",DLAYGO=446.7,X=SSRIEN D ^DIC K DIC,DLAYGO
S PRCPDA=Y+0
;*98 Send enhanced mail message if exception occurs during FileMan set
I Y=-1 N PRCPMSG D Q
. S PRCPMSG(1)="Error saving to File #446.7 for Stock Status Report, related data: "
. S PRCPSNM=$$GET1^DIQ(4,STA_",",.01)
. S PRCPMSG(2)="",PRCPMSG(3)="Station: "_STA_" "_PRCPSNM
. S PRCPMSG(4)="Inventory Point: "_$P(^TMP($J,"PRCPSSR1",STA,INV),U,4)_" "_$P(^TMP($J,"PRCPSSR1",STA,INV),U,5)
. S PRCPMSG(5)="File #446.7 Field Set Attempted: "_PRCPDR
. D MAIL^PRCPLO3 Q
;
S DIE="^PRCP(446.7,",DA=PRCPDA D ^DIE K DIE,DR,DA
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPLO2A 8967 printed Dec 13, 2024@02:14:07 Page 2
PRCPLO2A ;WOIFO/DAP-stock status report (cont) ; 1/26/06 12:00pm
V ;;5.1;IFCAP;**83,98,112**;Oct 20, 2000;Build 2
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;External reference to $$GET1^DIQ(4, is supported by ICR# 10090
+3 ; *112 changes by: VMP, Holloway,T.
+4 ;
ENT ;*83 Building ^TMP with total result data, totaling logic pulled from PRCPRSS0
+1 NEW PRCPIN,PRCPIN1,PRCPIN2,PRCPIN3,TOTVAL,TOTCLOS,TOTCLO1,TOTCLO2,SSRIEN
+2 SET U="^"
SET STA=PRC("SITE")
SET INV=PRCP("I")
+3 ;
SSR1 ;*98 First Stock Status Report data field set
+1 ;
+2 ;Station #
SET $PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,1)=STA
+3 SET DATRN=$$FMTE^XLFDT(DATESTRT)
+4 SET DATRN1=$PIECE(DATRN," ",1)_","_$PIECE(DATRN," ",2)
+5 ;Date Range
SET $PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,2)=DATRN1
+6 ;Inactivity Range
SET $PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,3)=INARNG
+7 ;Inventory Point #
SET $PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,4)=INV
+8 ;*83 Retrieve external inventory point name and primary/secondary/
+9 ;warehouse indicator
+10 SET PRCPIN=$GET(^PRCP(445,INV,0))
+11 IF PRCPIN'=""
SET PRCPIN1=$PIECE(PRCPIN,"^",1)
SET PRCPIN2=$PIECE(PRCPIN1,"-",2,99)
+12 IF PRCPIN'=""
SET PRCPIN3=$PIECE(PRCPIN,"^",3)
+13 IF PRCPIN=""
SET PRCPIN2=""
SET PRCPIN3=""
+14 ; Needed due to "*" delimiter
SET PRCPIN2=$TRANSLATE(PRCPIN2,"*","|")
+15 ;Inventory Point Name
SET $PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,5)=PRCPIN2
+16 ;P/S/W Indicator
SET $PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,6)=PRCPIN3
+17 ;
+18 SET PRCPDX=$TRANSLATE(^TMP($JOB,"PRCPSSR1",STA,INV),"^","*")
SET DR="3///"_PRCPDX
+19 DO FILE
+20 ;
SSR2 ;*98 Second Stock Status Report data field set
+1 ;
+2 SET TOTOPEN=0
FOR ACCT=1,2,3,6,8
SET %=$PIECE($GET(^TMP($JOB,1,"OPEN",ACCT)),U,2)
SET TOTOPEN=TOTOPEN+%
+3 ;Std. Open Balance Total $
SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,1)=TOTOPEN
+4 SET TOTOPEN=0
FOR ACCT=1,2,3,6,8
SET %=$PIECE($GET(^TMP($JOB,2,"OPEN",ACCT)),U,2)
SET TOTOPEN=TOTOPEN+%
+5 ;ODI Open Balance Total $
SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,2)=TOTOPEN
+6 SET TOTOPEN=0
FOR ACCT=1,2,3,6,8
SET %=$PIECE($GET(^TMP($JOB,3,"OPEN",ACCT)),U,2)
SET TOTOPEN=TOTOPEN+%
+7 ;All Open Balance Total $
SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,3)=TOTOPEN
+8 ;
+9 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,4)=+$GET(^TMP($JOB,1,"REC","TOTAL"))
+10 ;Std. Receipts Total $
+11 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,5)=+$GET(^TMP($JOB,2,"REC","TOTAL"))
+12 ;ODI Receipts Total $
+13 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,6)=+$GET(^TMP($JOB,3,"REC","TOTAL"))
+14 ;All Receipts Total $
+15 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,7)=+$GET(^TMP($JOB,1,"ISS","TOTAL"))
+16 ;Std. Usages Total $
+17 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,8)=+$GET(^TMP($JOB,2,"ISS","TOTAL"))
+18 ;ODI Usages Total $
+19 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,9)=+$GET(^TMP($JOB,3,"ISS","TOTAL"))
+20 ;All Usages Total $
+21 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,10)=+$GET(^TMP($JOB,1,"ADJ","TOTAL"))
+22 ;Std. Adjustments Total $
+23 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,11)=+$GET(^TMP($JOB,2,"ADJ","TOTAL"))
+24 ;ODI Adjustments Total $
+25 SET $PIECE(^TMP($JOB,"PRCPSSR2",STA,INV),U,12)=+$GET(^TMP($JOB,3,"ADJ","TOTAL"))
+26 ;All Adjustments Total $
+27 ;
+28 SET PRCPDX=$TRANSLATE(^TMP($JOB,"PRCPSSR2",STA,INV),"^","*")
SET DR="4///"_PRCPDX
+29 DO FILE
+30 ;
SSR3 ;*98 Third Stock Status Report data field set
+1 ;
+2 SET TOTCLOS=0
+3 SET TOTCLOS=$PIECE($GET(^TMP($JOB,"PRCPSSR2",STA,INV)),U,1)+$GET(^TMP($JOB,1,"REC","TOTAL"))
+4 SET TOTCLOS=TOTCLOS+$GET(^TMP($JOB,1,"ISS","TOTAL"))+$GET(^TMP($JOB,1,"ADJ","TOTAL"))
+5 ;Std. Closing Bal Total $
SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,1)=TOTCLOS
+6 SET TOTCLO1=0
+7 SET TOTCLO1=$PIECE($GET(^TMP($JOB,"PRCPSSR2",STA,INV)),U,2)+$GET(^TMP($JOB,2,"REC","TOTAL"))
+8 SET TOTCLO1=TOTCLO1+$GET(^TMP($JOB,2,"ISS","TOTAL"))+$GET(^TMP($JOB,2,"ADJ","TOTAL"))
+9 ;ODI Closing Bal Total $
SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,2)=TOTCLO1
+10 SET TOTCLO2=0
+11 SET TOTCLO2=$PIECE($GET(^TMP($JOB,"PRCPSSR2",STA,INV)),U,3)+$GET(^TMP($JOB,3,"REC","TOTAL"))
+12 SET TOTCLO2=TOTCLO2+$GET(^TMP($JOB,3,"ISS","TOTAL"))+$GET(^TMP($JOB,3,"ADJ","TOTAL"))
+13 ;All Closing Bal Total $
SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,3)=TOTCLO2
+14 ;
+15 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,4)=+$GET(^TMP($JOB,1,"RECN","TOTAL"))
+16 ;# Std. Receipts
+17 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,5)=+$GET(^TMP($JOB,2,"RECN","TOTAL"))
+18 ;# ODI Receipts
+19 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,6)=+$GET(^TMP($JOB,3,"RECN","TOTAL"))
+20 ;# All Receipts
+21 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,7)=+$GET(^TMP($JOB,1,"ISSN","TOTAL"))
+22 ;# Std. Issues
+23 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,8)=+$GET(^TMP($JOB,2,"ISSN","TOTAL"))
+24 ;# ODI Issues
+25 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,9)=+$GET(^TMP($JOB,3,"ISSN","TOTAL"))
+26 ;# All Issues
+27 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,10)=+$GET(^TMP($JOB,1,"ADJN","TOTAL"))
+28 ;# Std. Adjustments
+29 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,11)=+$GET(^TMP($JOB,2,"ADJN","TOTAL"))
+30 ;# ODI Adjustments
+31 SET $PIECE(^TMP($JOB,"PRCPSSR3",STA,INV),U,12)=+$GET(^TMP($JOB,3,"ADJN","TOTAL"))
+32 ;# All Adjustments
+33 ;
+34 SET PRCPDX=$TRANSLATE(^TMP($JOB,"PRCPSSR3",STA,INV),"^","*")
SET DR="5///"_PRCPDX
+35 DO FILE
+36 ;
SSR4 ;*98 Fourth Stock Status Report data field set
+1 ;
+2 ;*83 Turnover computation logic also pulled from PRCPRSS0
+3 SET DAYS=$PIECE("31^28^31^30^31^30^31^31^30^31^30^31",U,+$EXTRACT(DATESTRT,4,5))
+4 IF DAYS=28
SET %=(17+$EXTRACT(DATESTRT))_$EXTRACT(DATESTRT,2,3)
SET DAYS=$SELECT(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28)
+5 ;
+6 SET %=($GET(^TMP($JOB,1,"ISS","TOTAL"))*365)/DAYS
SET %=$SELECT('TOTCLOS:0,1:-%/TOTCLOS)
+7 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,1)=$JUSTIFY(%,0,2)
+8 ;Std. Turnover
+9 SET %=($GET(^TMP($JOB,2,"ISS","TOTAL"))*365)/DAYS
SET %=$SELECT('TOTCLO1:0,1:-%/TOTCLO1)
+10 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,2)=$JUSTIFY(%,0,2)
+11 ;ODI Turnover
+12 SET %=($GET(^TMP($JOB,3,"ISS","TOTAL"))*365)/DAYS
SET %=$SELECT('TOTCLO2:0,1:-%/TOTCLO2)
+13 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,3)=$JUSTIFY(%,0,2)
+14 ;All Turnover
+15 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,4)=+$GET(^TMP($JOB,1,"INACTN","TOTAL"))
+16 ;# Std. Inactive
+17 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,5)=+$GET(^TMP($JOB,2,"INACTN","TOTAL"))
+18 ;# ODI Inactive
+19 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,6)=+$GET(^TMP($JOB,3,"INACTN","TOTAL"))
+20 ;# All Inactive
+21 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,7)=+$GET(^TMP($JOB,1,"INACT","TOTAL"))
+22 ;Std Inactive Total $
+23 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,8)=+$GET(^TMP($JOB,2,"INACT","TOTAL"))
+24 ;ODI Inactive Total $
+25 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,9)=+$GET(^TMP($JOB,3,"INACT","TOTAL"))
+26 ;All Inactive Total $
+27 ;
+28 SET %=$SELECT('$GET(^TMP($JOB,1,"VALUE","TOTAL")):0,1:$GET(^TMP($JOB,1,"INACT","TOTAL"))/$GET(^TMP($JOB,1,"VALUE","TOTAL")))
+29 IF %=""
SET %=0
+30 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,10)=$JUSTIFY(%,0,2)
+31 ;Std. Inactive %
+32 SET %=$SELECT('$GET(^TMP($JOB,2,"VALUE","TOTAL")):0,1:$GET(^TMP($JOB,2,"INACT","TOTAL"))/$GET(^TMP($JOB,2,"VALUE","TOTAL")))
+33 IF %=""
SET %=0
+34 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,11)=$JUSTIFY(%,0,2)
+35 ;ODI Inactive %
+36 SET %=$SELECT('$GET(^TMP($JOB,3,"VALUE","TOTAL")):0,1:$GET(^TMP($JOB,3,"INACT","TOTAL"))/$GET(^TMP($JOB,3,"VALUE","TOTAL")))
+37 IF %=""
SET %=0
+38 SET $PIECE(^TMP($JOB,"PRCPSSR4",STA,INV),U,12)=$JUSTIFY(%,0,2)
+39 ;All Inactive %
+40 ;
+41 SET PRCPDX=$TRANSLATE(^TMP($JOB,"PRCPSSR4",STA,INV),"^","*")
SET DR="6///"_PRCPDX
+42 DO FILE
+43 ;
SSR5 ;*98 Fifth Stock Status Report data field set
+1 ;
+2 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,1)=+$GET(^TMP($JOB,1,"LONGN","TOTAL"))
+3 ;# Std. Long Supply
+4 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,2)=+$GET(^TMP($JOB,2,"LONGN","TOTAL"))
+5 ;# ODI Long Supply
+6 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,3)=+$GET(^TMP($JOB,3,"LONGN","TOTAL"))
+7 ;# All Long Supply
+8 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,4)=+$GET(^TMP($JOB,1,"LONG","TOTAL"))
+9 ;Std. Long Supply Total $
+10 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,5)=+$GET(^TMP($JOB,2,"LONG","TOTAL"))
+11 ;ODI Long Supply Total $
+12 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,6)=+$GET(^TMP($JOB,3,"LONG","TOTAL"))
+13 ;All Long Supply Total $
+14 ;
+15 SET %=$SELECT('$GET(^TMP($JOB,1,"VALUE","TOTAL")):0,1:$GET(^TMP($JOB,1,"LONG","TOTAL"))/$GET(^TMP($JOB,1,"VALUE","TOTAL")))
+16 IF %=""
SET %=0
+17 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,7)=$JUSTIFY(%,0,2)
+18 ;Std. Long Supply %
+19 SET %=$SELECT('$GET(^TMP($JOB,2,"VALUE","TOTAL")):0,1:$GET(^TMP($JOB,2,"LONG","TOTAL"))/$GET(^TMP($JOB,2,"VALUE","TOTAL")))
+20 IF %=""
SET %=0
+21 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,8)=$JUSTIFY(%,0,2)
+22 ;ODI Long Supply %
+23 SET %=$SELECT('$GET(^TMP($JOB,3,"VALUE","TOTAL")):0,1:$GET(^TMP($JOB,3,"LONG","TOTAL"))/$GET(^TMP($JOB,3,"VALUE","TOTAL")))
+24 IF %=""
SET %=0
+25 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,9)=$JUSTIFY(%,0,2)
+26 ;All Long Supply %
+27 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,10)=+$GET(^TMP($JOB,1,"CNT","TOTAL"))
+28 ;# Std. Items
+29 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,11)=+$GET(^TMP($JOB,2,"CNT","TOTAL"))
+30 ;# On-Demand Items
+31 SET $PIECE(^TMP($JOB,"PRCPSSR5",STA,INV),U,12)=+$GET(^TMP($JOB,3,"CNT","TOTAL"))
+32 ;# All Items
+33 ;
+34 SET PRCPDX=$TRANSLATE(^TMP($JOB,"PRCPSSR5",STA,INV),"^","*")
SET DR="7///"_PRCPDX
+35 DO FILE
+36 KILL Y
+37 ;
+38 QUIT
+39 ;
+40 ;*98 Created filing subroutine
FILE ; Subroutine that creates entries in File #446.7 fields as they
+1 ; are created
+2 ;
+3 NEW PRCPDR,PRCPSNM,PRCPDA,PRCPDX,X,Y
+4 SET PRCPDR=DR
+5 SET SSRIEN=STA_INV
+6 SET DIC="^PRCP(446.7,"
SET DIC(0)="L"
SET DLAYGO=446.7
SET X=SSRIEN
DO ^DIC
KILL DIC,DLAYGO
+7 SET PRCPDA=Y+0
+8 ;*98 Send enhanced mail message if exception occurs during FileMan set
+9 IF Y=-1
NEW PRCPMSG
Begin DoDot:1
+10 SET PRCPMSG(1)="Error saving to File #446.7 for Stock Status Report, related data: "
+11 SET PRCPSNM=$$GET1^DIQ(4,STA_",",.01)
+12 SET PRCPMSG(2)=""
SET PRCPMSG(3)="Station: "_STA_" "_PRCPSNM
+13 SET PRCPMSG(4)="Inventory Point: "_$PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,4)_" "_$PIECE(^TMP($JOB,"PRCPSSR1",STA,INV),U,5)
+14 SET PRCPMSG(5)="File #446.7 Field Set Attempted: "_PRCPDR
+15 DO MAIL^PRCPLO3
QUIT
End DoDot:1
QUIT
+16 ;
+17 SET DIE="^PRCP(446.7,"
SET DA=PRCPDA
DO ^DIE
KILL DIE,DR,DA
+18 ;
+19 QUIT
