PRCPLO ;WOIFO/RLL/VAC/DAP-days of stock on hand report ; 2/26/07 1:53pm
;;5.1;IFCAP;**83,98**;Oct 20, 2000;Build 37
;Per VHA Directive 2004-038, this routine should not be modified.
; Note: This routine was copied from PRCPRSOH
;*98 Code modification made to handle STD and ODI breakouts
;
Q
ENT ; Entry Point to run Program
L +^PRCP(446.7,"STATUS"):3 I $T=0 S PRCPMSG(1)="Error encountered when attempting to run CLO GIP Reports due to other CLRS extracts in progress, please try again later." D MAIL^PRCPLO3 Q
N TOSTDCNT,TOODICNT,TOALLCNT,TOTCNT,VALUES
D PRCPRINV ; Run the logic from PRCPRSOH, get params
D BLDFIL ; Build the output data
D GETVAL ; Set the ^DIE Entries in 446.7
L -^PRCP(446.7,"STATUS")
;
K ^TMP($J,"PRCPSOH") ;kill off tmp data
K ^TMP($J,"PRCPLO") ;kill off tmp data
K ^TMP($J,"PRCPSOH2") ; kill off ODI tmp data
K ^TMP($J,"PRCPLO2") ;kill off ODI tmp data
Q
;
;
PRCPRINV ; run INV Point
N CLRSFLAG
S CLRSFLAG="SOH"
D GETIPT^PRCPLO1
Q
EN1 ; Added return from PRCPLO1
; Q
N DATEEND,DATEENDD,DATESTRD,DATESTRT,DAYSLEFT,DIR,GROUPALL,PRCPDAYS,PRCPEND,PRCPSTRT,PRCPTYPE,TOTALDAY,X,X1,X2,Y,MNT,TODAY
N ODICNT,ODIDOL,ODIFLAG,ODIFLG,STDCNT,STDDOL
;
; *83 The following was edited to always enter the LAST DAY
; of the previous month as the end date. End date for Oct 31, 2005
; in FM 3051031, can also use 3051100 equivalent for date sort
; this way, you do not have to handle months w/ 28, 29, 30 or 31 days
D NOW^%DTC S TODAY=X,Y=$E(X,1,3),MNT=$E(X,4,5)
S MNT=+(MNT)
S MNT=MNT-1
I MNT=0 S MNT=12,Y=Y-1
I $L(MNT)=1 S MNT=0_MNT
;
; *83 Added day logic to handle month/leap year, etc.
N DAYS,CKF
S DAYS=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+(MNT))
S DATEEND=Y_MNT_DAYS
I DAYS=28 D
. S CKF=(17+$E(DATEEND))_$E(DATEEND,2,3)
. S DAYS=$S(CKF#400=0:29,(CKF#4=0&(CKF#100'=0)):29,1:28)
. S DATEEND=Y_MNT_DAYS
. Q
; S DATEEND=Y_MNT_"00"
; *83 The following was edited to always enter a 90 day previous
; to current date of report run (check param file, could change)
; for the DATESTRT. Once DATEEND and DATESTRT are determined, we
; can use the existing code to set the other variables
S X1=TODAY
; *83 Report range supplied by site parameter and defaulted to 180
S X2=$$GET^XPAR("SYS","PRCPLO REPORT RANGE",1,"Q")
I X2="" S X2=180
S X2=(X2*-1)
D C^%DTC S DATESTRT=$E(X,1,5)_"01"
; DATEEND and DATESTRT are set above, pass them to existing
; logic below to set remaining variables
S X1=DATEEND,X2=DATESTRT D ^%DTC S TOTALDAY=X+1
S Y=DATEEND D DD^%DT S DATEENDD=Y,Y=DATESTRT D DD^%DT S DATESTRD=Y
;
;*83 Set PRCPTYPE=2 (always GREATER)
S PRCPTYPE=2
;
;*83 PRCPDAYS is set based on value of CLRS GREATER THAN RANGE parameter
;if no value is presented in the parameter, it will default to 90
;
S PRCPDAYS=$$GET^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,"Q")
I PRCPDAYS="" S PRCPDAYS=90
;
;*83 Return PRCPSTRT="" and PRCPEND=""
I PRCP("DPTYPE")="W" D
. S PRCPSTRT="",PRCPEND=""
;
;*83 RETURN GROUPALL=1 to select all groups
I PRCP("DPTYPE")'="W" D
. S GROUPALL=1
. ; finished adding variables
;
DQ ; queue starts here
N AVERAGE,DATE,GROUP,GROUPNM,ITEMDA,ITEMDATA,NSN,ONHAND,TOTAL,X,Y
K ^TMP($J,"PRCPRSOH")
S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA S ITEMDATA=$G(^(ITEMDA,0)) I ITEMDATA'="" D
. S ODIFLG=1 S ODIFLAG=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
. I ODIFLAG="Y" S ODIFLG=2
. S TOTCNT(PRCP("I"),ODIFLG)=+$G(TOTCNT(PRCP("I"),ODIFLG))+1
. I $$REUSABLE^PRCPU441(ITEMDA) Q
. ; calculate total usage between dates
. S DATE=$E(DATESTRT,1,5)-.01,TOTAL=0 F S DATE=$O(^PRCP(445,PRCP("I"),1,ITEMDA,2,DATE)) Q:'DATE!(DATE>$E(DATEEND,1,5)) S TOTAL=TOTAL+$P($G(^(DATE,0)),"^",2)
. S AVERAGE=$J(TOTAL/TOTALDAY,0,2),ONHAND=$P(ITEMDATA,"^",7)+$P(ITEMDATA,"^",19)
. S DAYSLEFT=$S('AVERAGE&(ONHAND):9999999,'AVERAGE:0,1:ONHAND/AVERAGE\1)
. I PRCPTYPE=1,DAYSLEFT'<PRCPDAYS Q
. I PRCPTYPE=2,DAYSLEFT'>PRCPDAYS Q
. ; sort for whse
. I PRCP("DPTYPE")="W" D Q
. . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
. . I $E(NSN,1,$L(PRCPSTRT))'=PRCPSTRT,$E(NSN,1,$L(PRCPEND))'=PRCPEND I NSN']PRCPSTRT!(PRCPEND']NSN) Q
. . ; S ^TMP($J,"PRCPRSOH",NSN,ITEMDA)=TOTAL_"^"_AVERAGE_"^"_ONHAND_"^"_$P(DAYSLEFT,".")_"^"_$P(ITEMDATA,"^",27)
. . N ITMCHK
. . S ITMCHK=0,ITMCHK=$O(^PRCP(445,PRCP("I"),1,ITMCHK))
. . Q:ITMCHK=""!(+(ITMCHK)<1)
. . Q:+(ITMCHK)<1 ; made it to x-ref
. . D BLDTMP
. ;98* Accumulate count information
. S VALUES(PRCP("I"),ODIFLG)=+$G(VALUES(PRCP("I"),ODIFLG))+1
. ; sort for primary and secondary
. S GROUP=+$P(ITEMDATA,"^",21)
. I 'GROUP,'$G(GROUPALL) Q
. I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) Q
. I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) Q
. S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
. I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
. S:GROUPNM="" GROUPNM=" "
. ;*83, Create TMP structure for Report
. N ITMCHK
. S ITMCHK=0,ITMCHK=$O(^PRCP(445,PRCP("I"),1,ITMCHK))
. Q:ITMCHK=""!(+(ITMCHK)<1)
. Q:ITMCHK<1 ; made it to x-ref
. D BLDTMP
. Q
Q
;
BLDTMP ;*83 Build ^TMP Structure for Report Server
;
N INVTYPE,ITEMDESC,CSTCTR,INDAT,NUMLNIT,DATRN,DATRN1,INVPTID
N CSTC1,CSTC2,CSTC3,CSCE1,CSCE2,V4TR,V4TR1
;
S DATRN=$$FMTE^XLFDT(+DATEEND)
S DATRN1=$P(DATRN," ",1)_","_$P(DATRN," ",3)
S ITEMDESC=$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,15) ; item Desc
I ITEMDESC="" S ITEMDESC="No Item Desc"
Q:ITEMDA=""!(+(ITEMDA)<1)
;
S NUMLNIT=1 ; set to 1 for each line item.
S INVTYPE=PRCP("DPTYPE")
I INVTYPE="" S INVTYPE="No Inv Type"
S INDAT=$G(PRCP("PAR"))
S INVPTID=PRCP("I") ; inv point id #
; Cost Center logic
; Get ^PRCP(445,INVPTID,0) 7th piece (int. Cost Center #)
; Get ^PRCD(420.1,IntCstCtr,0) 1st piece (external format)
S CSTC1=$G(^PRCP(445,INVPTID,0)),CSTC2=$P(CSTC1,"^",7),CSTC3=$P(CSTC1,"^",3)
S V4TR=$P(CSTC1,"^",1),V4TR1=$P(V4TR,"-",2,99) ; *83 look up name
S V4TR1=$TR(V4TR1,"*","|") ; $TR name to replace "*"'s with "|"'s
I CSTC2'="" S CSCE1=$G(^PRCD(420.1,CSTC2,0)),CSCE2=$P(CSCE1,"^",1)
I CSTC2="" S CSCE2="No Cost Center"
; *83, Set 5th Node from ITEMDESC to ITEMDA
S ^TMP($J,"PRCPLO",V3,INVPTID,ITEMDA)=V3_"*"_DATRN1_"*"_INVPTID_"*"_V4TR1_"*"_NUMLNIT_"*"_$P(ITEMDATA,"^",27)_"*"_CSCE2_"*"_INVTYPE
; *98 Split information for ODI and Standard
S ^TMP($J,"PRCPLO2",V3,INVPTID,ITEMDA,ODIFLG)=+$G(^TMP($J,"PRCPLO2",V3,INVPTID,ITEMDA,ODIFLG))+$P(ITEMDATA,"^",27)
Q
BLDFIL ; Build output file
N IN1,IN2,IN3,IN4,IN5,OLPV,NWPV,INDDAT,TOTDOL,LNDOL,CSTCTR,LNCT,PRCPDX,INPTVAL,POINT,STID,DTTM,INVVTYP,INVPTLN
S IN1=0,IN2=0,IN3=0,IN4=0,IN5="INVPT",INDDAT=0,OLPV=0,NWPV=0,LNCT=0,CSTCTR=0,TOTDOL=0,LNDOL=0,INVPTLN=0
S STDCNT=0,ODICNT=0
S (STDDOL,ODIDOL)=0
F S IN1=$O(^TMP($J,"PRCPLO",IN1)) Q:IN1="" D
. ;S (STDDOL,ODIDOL)=0
. F S IN2=$O(^TMP($J,"PRCPLO",IN1,IN2)) Q:IN2="" D
. . I IN5'="INVPT" D ; init for first time through
. . . S INVPTLN=+$P($G(^PRCP(445,+INPTVAL,1,0)),"^",4)
. . . S TOSTDCNT=+$G(TOTCNT(IN2,1)),TOODICNT=+$G(TOTCNT(IN2,2)),TOALLCNT=TOSTDCNT+TOODICNT
. . . S PRCPDX=STID_"*"_DTTM_"*"_INPTVAL_"*"_POINT_"*"_INVVTYP_"*"_TOTDOL_"*"_IN4_"*"_INVPTLN_"*"_CSTCTR
. . . ; set up new ^TMP($J NODE to store totals for ^DIE set
. . . S ^TMP($J,"PRCPSOH",+(STID_INPTVAL))=PRCPDX
. . . S STDCNT=+$G(VALUES(INPTVAL,1)),ODICNT=+$G(VALUES(INPTVAL,2))
. . . S TOSTDCNT=+$G(TOTCNT(INPTVAL,1)),TOODICNT=+$G(TOTCNT(INPTVAL,2))
. . . S TOALLCNT=TOSTDCNT+TOODICNT
. . . S ^TMP($J,"PRCPSOH2",+(STID_INPTVAL))=STDDOL_"*"_ODIDOL_"*"_(STDDOL+ODIDOL)_"*"_STDCNT_"*"_ODICNT_"*"_(STDCNT+ODICNT)_"*"_TOSTDCNT_"*"_TOODICNT_"*"_TOALLCNT
. . . S IN4=0 ; reset to 0, begin counting Line items for INVPT
. . . S TOTDOL=0
. . . S LNDOL=0
. . . S PRCPDX=""
. . . S CSTCTR=""
. . . S (STDDOL,ODIDOL)=0
. . F S IN3=$O(^TMP($J,"PRCPLO",IN1,IN2,IN3)) Q:IN3="" D
. . . S INDDAT=$G(^TMP($J,"PRCPLO",IN1,IN2,IN3))
. . . S STID=$P(INDDAT,"*",1)
. . . S DTTM=$P(INDDAT,"*",2)
. . . S POINT=$P(INDDAT,"*",4)
. . . S INPTVAL=$P(INDDAT,"*",3) ; Inv Point ID# for DIE Set
. . . S CSTCTR=$P(INDDAT,"*",7)
. . . S LNDOL=$P(INDDAT,"*",6)
. . . S INVVTYP=$P(INDDAT,"*",8)
. . . S TOTDOL=TOTDOL+LNDOL
. . . S IN4=IN4+1 ; Count # of line items in Inv Pt
. . . S IN5=IN2 ; Invt. Point
. . . S STDDOL=STDDOL+$G(^TMP($J,"PRCPLO2",IN1,IN2,IN3,1))
. . . S ODIDOL=ODIDOL+$G(^TMP($J,"PRCPLO2",IN1,IN2,IN3,2))
. . . Q
. . Q
. Q
Q
GETVAL ; Get values from ^TMP($J,"PRCPSOH"
N LP1,SOHIEN,PRCPDX
S LP1=0
F S LP1=$O(^TMP($J,"PRCPSOH",LP1)) Q:LP1="" D
. S PRCPDX=$G(^TMP($J,"PRCPSOH",LP1))
. S SOHIEN=+LP1
. S DR="1///"_PRCPDX
. D SETREC
. S PRCPDX=$G(^TMP($J,"PRCPSOH2",LP1))
. S DR="2///"_PRCPDX
. D SETREC
. Q
Q
SETREC ; Set record using DIE in 446.7
;
N PRCPDR,PRCPST,PRCPSNM,PRCPDA,PRCPDX,PRCPST,X,Y
S PRCPDR=DR
S DIC="^PRCP(446.7,",DIC(0)="L",DLAYGO=446.7,X=SOHIEN D ^DIC K DIC,DLAYGO
S PRCPDA=Y+0
S PRCPST=$P(^TMP($J,"PRCPSOH",LP1),"*",1)
S PRCPSNM=$$GET1^DIQ(4,PRCPST_",",.01)
;*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 Days of Stock on Hand Report, related data: "
. S PRCPMSG(2)="",PRCPMSG(3)="Station: "_PRCPST_" "_PRCPSNM
. S PRCPMSG(4)="Inventory Point: "_$P(^TMP($J,"PRCPSOH",LP1),"*",3)_" "_$P(^TMP($J,"PRCPSOH",LP1),"*",4)
. 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[HPRCPLO 9741 printed Sep 23, 2025@19:50:08 Page 2
PRCPLO ;WOIFO/RLL/VAC/DAP-days of stock on hand report ; 2/26/07 1:53pm
+1 ;;5.1;IFCAP;**83,98**;Oct 20, 2000;Build 37
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ; Note: This routine was copied from PRCPRSOH
+4 ;*98 Code modification made to handle STD and ODI breakouts
+5 ;
+6 QUIT
ENT ; Entry Point to run Program
+1 LOCK +^PRCP(446.7,"STATUS"):3
IF $TEST=0
SET PRCPMSG(1)="Error encountered when attempting to run CLO GIP Reports due to other CLRS extracts in progress, please try again later."
DO MAIL^PRCPLO3
QUIT
+2 NEW TOSTDCNT,TOODICNT,TOALLCNT,TOTCNT,VALUES
+3 ; Run the logic from PRCPRSOH, get params
DO PRCPRINV
+4 ; Build the output data
DO BLDFIL
+5 ; Set the ^DIE Entries in 446.7
DO GETVAL
+6 LOCK -^PRCP(446.7,"STATUS")
+7 ;
+8 ;kill off tmp data
KILL ^TMP($JOB,"PRCPSOH")
+9 ;kill off tmp data
KILL ^TMP($JOB,"PRCPLO")
+10 ; kill off ODI tmp data
KILL ^TMP($JOB,"PRCPSOH2")
+11 ;kill off ODI tmp data
KILL ^TMP($JOB,"PRCPLO2")
+12 QUIT
+13 ;
+14 ;
PRCPRINV ; run INV Point
+1 NEW CLRSFLAG
+2 SET CLRSFLAG="SOH"
+3 DO GETIPT^PRCPLO1
+4 QUIT
EN1 ; Added return from PRCPLO1
+1 ; Q
+2 NEW DATEEND,DATEENDD,DATESTRD,DATESTRT,DAYSLEFT,DIR,GROUPALL,PRCPDAYS,PRCPEND,PRCPSTRT,PRCPTYPE,TOTALDAY,X,X1,X2,Y,MNT,TODAY
+3 NEW ODICNT,ODIDOL,ODIFLAG,ODIFLG,STDCNT,STDDOL
+4 ;
+5 ; *83 The following was edited to always enter the LAST DAY
+6 ; of the previous month as the end date. End date for Oct 31, 2005
+7 ; in FM 3051031, can also use 3051100 equivalent for date sort
+8 ; this way, you do not have to handle months w/ 28, 29, 30 or 31 days
+9 DO NOW^%DTC
SET TODAY=X
SET Y=$EXTRACT(X,1,3)
SET MNT=$EXTRACT(X,4,5)
+10 SET MNT=+(MNT)
+11 SET MNT=MNT-1
+12 IF MNT=0
SET MNT=12
SET Y=Y-1
+13 IF $LENGTH(MNT)=1
SET MNT=0_MNT
+14 ;
+15 ; *83 Added day logic to handle month/leap year, etc.
+16 NEW DAYS,CKF
+17 SET DAYS=$PIECE("31^28^31^30^31^30^31^31^30^31^30^31",U,+(MNT))
+18 SET DATEEND=Y_MNT_DAYS
+19 IF DAYS=28
Begin DoDot:1
+20 SET CKF=(17+$EXTRACT(DATEEND))_$EXTRACT(DATEEND,2,3)
+21 SET DAYS=$SELECT(CKF#400=0:29,(CKF#4=0&(CKF#100'=0)):29,1:28)
+22 SET DATEEND=Y_MNT_DAYS
+23 QUIT
End DoDot:1
+24 ; S DATEEND=Y_MNT_"00"
+25 ; *83 The following was edited to always enter a 90 day previous
+26 ; to current date of report run (check param file, could change)
+27 ; for the DATESTRT. Once DATEEND and DATESTRT are determined, we
+28 ; can use the existing code to set the other variables
+29 SET X1=TODAY
+30 ; *83 Report range supplied by site parameter and defaulted to 180
+31 SET X2=$$GET^XPAR("SYS","PRCPLO REPORT RANGE",1,"Q")
+32 IF X2=""
SET X2=180
+33 SET X2=(X2*-1)
+34 DO C^%DTC
SET DATESTRT=$EXTRACT(X,1,5)_"01"
+35 ; DATEEND and DATESTRT are set above, pass them to existing
+36 ; logic below to set remaining variables
+37 SET X1=DATEEND
SET X2=DATESTRT
DO ^%DTC
SET TOTALDAY=X+1
+38 SET Y=DATEEND
DO DD^%DT
SET DATEENDD=Y
SET Y=DATESTRT
DO DD^%DT
SET DATESTRD=Y
+39 ;
+40 ;*83 Set PRCPTYPE=2 (always GREATER)
+41 SET PRCPTYPE=2
+42 ;
+43 ;*83 PRCPDAYS is set based on value of CLRS GREATER THAN RANGE parameter
+44 ;if no value is presented in the parameter, it will default to 90
+45 ;
+46 SET PRCPDAYS=$$GET^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,"Q")
+47 IF PRCPDAYS=""
SET PRCPDAYS=90
+48 ;
+49 ;*83 Return PRCPSTRT="" and PRCPEND=""
+50 IF PRCP("DPTYPE")="W"
Begin DoDot:1
+51 SET PRCPSTRT=""
SET PRCPEND=""
End DoDot:1
+52 ;
+53 ;*83 RETURN GROUPALL=1 to select all groups
+54 IF PRCP("DPTYPE")'="W"
Begin DoDot:1
+55 SET GROUPALL=1
+56 ; finished adding variables
End DoDot:1
+57 ;
DQ ; queue starts here
+1 NEW AVERAGE,DATE,GROUP,GROUPNM,ITEMDA,ITEMDATA,NSN,ONHAND,TOTAL,X,Y
+2 KILL ^TMP($JOB,"PRCPRSOH")
+3 SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))
if 'ITEMDA
QUIT
SET ITEMDATA=$GET(^(ITEMDA,0))
IF ITEMDATA'=""
Begin DoDot:1
+4 SET ODIFLG=1
SET ODIFLAG=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
+5 IF ODIFLAG="Y"
SET ODIFLG=2
+6 SET TOTCNT(PRCP("I"),ODIFLG)=+$GET(TOTCNT(PRCP("I"),ODIFLG))+1
+7 IF $$REUSABLE^PRCPU441(ITEMDA)
QUIT
+8 ; calculate total usage between dates
+9 SET DATE=$EXTRACT(DATESTRT,1,5)-.01
SET TOTAL=0
FOR
SET DATE=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA,2,DATE))
if 'DATE!(DATE>$EXTRACT(DATEEND,1,5))
QUIT
SET TOTAL=TOTAL+$PIECE($GET(^(DATE,0)),"^",2)
+10 SET AVERAGE=$JUSTIFY(TOTAL/TOTALDAY,0,2)
SET ONHAND=$PIECE(ITEMDATA,"^",7)+$PIECE(ITEMDATA,"^",19)
+11 SET DAYSLEFT=$SELECT('AVERAGE&(ONHAND):9999999,'AVERAGE:0,1:ONHAND/AVERAGE\1)
+12 IF PRCPTYPE=1
IF DAYSLEFT'<PRCPDAYS
QUIT
+13 IF PRCPTYPE=2
IF DAYSLEFT'>PRCPDAYS
QUIT
+14 ; sort for whse
+15 IF PRCP("DPTYPE")="W"
Begin DoDot:2
+16 SET NSN=$$NSN^PRCPUX1(ITEMDA)
if NSN=""
SET NSN=" "
+17 IF $EXTRACT(NSN,1,$LENGTH(PRCPSTRT))'=PRCPSTRT
IF $EXTRACT(NSN,1,$LENGTH(PRCPEND))'=PRCPEND
IF NSN']PRCPSTRT!(PRCPEND']NSN)
QUIT
+18 ; S ^TMP($J,"PRCPRSOH",NSN,ITEMDA)=TOTAL_"^"_AVERAGE_"^"_ONHAND_"^"_$P(DAYSLEFT,".")_"^"_$P(ITEMDATA,"^",27)
+19 NEW ITMCHK
+20 SET ITMCHK=0
SET ITMCHK=$ORDER(^PRCP(445,PRCP("I"),1,ITMCHK))
+21 if ITMCHK=""!(+(ITMCHK)<1)
QUIT
+22 ; made it to x-ref
if +(ITMCHK)<1
QUIT
+23 DO BLDTMP
End DoDot:2
QUIT
+24 ;98* Accumulate count information
+25 SET VALUES(PRCP("I"),ODIFLG)=+$GET(VALUES(PRCP("I"),ODIFLG))+1
+26 ; sort for primary and secondary
+27 SET GROUP=+$PIECE(ITEMDATA,"^",21)
+28 IF 'GROUP
IF '$GET(GROUPALL)
QUIT
+29 IF $GET(GROUPALL)
IF $DATA(^TMP($JOB,"PRCPURS1","NO",GROUP))
QUIT
+30 IF '$GET(GROUPALL)
IF '$DATA(^TMP($JOB,"PRCPURS1","YES",GROUP))
QUIT
+31 SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
+32 IF GROUPNM'=""
SET GROUPNM=$EXTRACT(GROUPNM,1,20)_" (#"_GROUP_")"
+33 if GROUPNM=""
SET GROUPNM=" "
+34 ;*83, Create TMP structure for Report
+35 NEW ITMCHK
+36 SET ITMCHK=0
SET ITMCHK=$ORDER(^PRCP(445,PRCP("I"),1,ITMCHK))
+37 if ITMCHK=""!(+(ITMCHK)<1)
QUIT
+38 ; made it to x-ref
if ITMCHK<1
QUIT
+39 DO BLDTMP
+40 QUIT
End DoDot:1
+41 QUIT
+42 ;
BLDTMP ;*83 Build ^TMP Structure for Report Server
+1 ;
+2 NEW INVTYPE,ITEMDESC,CSTCTR,INDAT,NUMLNIT,DATRN,DATRN1,INVPTID
+3 NEW CSTC1,CSTC2,CSTC3,CSCE1,CSCE2,V4TR,V4TR1
+4 ;
+5 SET DATRN=$$FMTE^XLFDT(+DATEEND)
+6 SET DATRN1=$PIECE(DATRN," ",1)_","_$PIECE(DATRN," ",3)
+7 ; item Desc
SET ITEMDESC=$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,15)
+8 IF ITEMDESC=""
SET ITEMDESC="No Item Desc"
+9 if ITEMDA=""!(+(ITEMDA)<1)
QUIT
+10 ;
+11 ; set to 1 for each line item.
SET NUMLNIT=1
+12 SET INVTYPE=PRCP("DPTYPE")
+13 IF INVTYPE=""
SET INVTYPE="No Inv Type"
+14 SET INDAT=$GET(PRCP("PAR"))
+15 ; inv point id #
SET INVPTID=PRCP("I")
+16 ; Cost Center logic
+17 ; Get ^PRCP(445,INVPTID,0) 7th piece (int. Cost Center #)
+18 ; Get ^PRCD(420.1,IntCstCtr,0) 1st piece (external format)
+19 SET CSTC1=$GET(^PRCP(445,INVPTID,0))
SET CSTC2=$PIECE(CSTC1,"^",7)
SET CSTC3=$PIECE(CSTC1,"^",3)
+20 ; *83 look up name
SET V4TR=$PIECE(CSTC1,"^",1)
SET V4TR1=$PIECE(V4TR,"-",2,99)
+21 ; $TR name to replace "*"'s with "|"'s
SET V4TR1=$TRANSLATE(V4TR1,"*","|")
+22 IF CSTC2'=""
SET CSCE1=$GET(^PRCD(420.1,CSTC2,0))
SET CSCE2=$PIECE(CSCE1,"^",1)
+23 IF CSTC2=""
SET CSCE2="No Cost Center"
+24 ; *83, Set 5th Node from ITEMDESC to ITEMDA
+25 SET ^TMP($JOB,"PRCPLO",V3,INVPTID,ITEMDA)=V3_"*"_DATRN1_"*"_INVPTID_"*"_V4TR1_"*"_NUMLNIT_"*"_$PIECE(ITEMDATA,"^",27)_"*"_CSCE2_"*"_INVTYPE
+26 ; *98 Split information for ODI and Standard
+27 SET ^TMP($JOB,"PRCPLO2",V3,INVPTID,ITEMDA,ODIFLG)=+$GET(^TMP($JOB,"PRCPLO2",V3,INVPTID,ITEMDA,ODIFLG))+$PIECE(ITEMDATA,"^",27)
+28 QUIT
BLDFIL ; Build output file
+1 NEW IN1,IN2,IN3,IN4,IN5,OLPV,NWPV,INDDAT,TOTDOL,LNDOL,CSTCTR,LNCT,PRCPDX,INPTVAL,POINT,STID,DTTM,INVVTYP,INVPTLN
+2 SET IN1=0
SET IN2=0
SET IN3=0
SET IN4=0
SET IN5="INVPT"
SET INDDAT=0
SET OLPV=0
SET NWPV=0
SET LNCT=0
SET CSTCTR=0
SET TOTDOL=0
SET LNDOL=0
SET INVPTLN=0
+3 SET STDCNT=0
SET ODICNT=0
+4 SET (STDDOL,ODIDOL)=0
+5 FOR
SET IN1=$ORDER(^TMP($JOB,"PRCPLO",IN1))
if IN1=""
QUIT
Begin DoDot:1
+6 ;S (STDDOL,ODIDOL)=0
+7 FOR
SET IN2=$ORDER(^TMP($JOB,"PRCPLO",IN1,IN2))
if IN2=""
QUIT
Begin DoDot:2
+8 ; init for first time through
IF IN5'="INVPT"
Begin DoDot:3
+9 SET INVPTLN=+$PIECE($GET(^PRCP(445,+INPTVAL,1,0)),"^",4)
+10 SET TOSTDCNT=+$GET(TOTCNT(IN2,1))
SET TOODICNT=+$GET(TOTCNT(IN2,2))
SET TOALLCNT=TOSTDCNT+TOODICNT
+11 SET PRCPDX=STID_"*"_DTTM_"*"_INPTVAL_"*"_POINT_"*"_INVVTYP_"*"_TOTDOL_"*"_IN4_"*"_INVPTLN_"*"_CSTCTR
+12 ; set up new ^TMP($J NODE to store totals for ^DIE set
+13 SET ^TMP($JOB,"PRCPSOH",+(STID_INPTVAL))=PRCPDX
+14 SET STDCNT=+$GET(VALUES(INPTVAL,1))
SET ODICNT=+$GET(VALUES(INPTVAL,2))
+15 SET TOSTDCNT=+$GET(TOTCNT(INPTVAL,1))
SET TOODICNT=+$GET(TOTCNT(INPTVAL,2))
+16 SET TOALLCNT=TOSTDCNT+TOODICNT
+17 SET ^TMP($JOB,"PRCPSOH2",+(STID_INPTVAL))=STDDOL_"*"_ODIDOL_"*"_(STDDOL+ODIDOL)_"*"_STDCNT_"*"_ODICNT_"*"_(STDCNT+ODICNT)_"*"_TOSTDCNT_"*"_TOODICNT_"*"_TOALLCNT
+18 ; reset to 0, begin counting Line items for INVPT
SET IN4=0
+19 SET TOTDOL=0
+20 SET LNDOL=0
+21 SET PRCPDX=""
+22 SET CSTCTR=""
+23 SET (STDDOL,ODIDOL)=0
End DoDot:3
+24 FOR
SET IN3=$ORDER(^TMP($JOB,"PRCPLO",IN1,IN2,IN3))
if IN3=""
QUIT
Begin DoDot:3
+25 SET INDDAT=$GET(^TMP($JOB,"PRCPLO",IN1,IN2,IN3))
+26 SET STID=$PIECE(INDDAT,"*",1)
+27 SET DTTM=$PIECE(INDDAT,"*",2)
+28 SET POINT=$PIECE(INDDAT,"*",4)
+29 ; Inv Point ID# for DIE Set
SET INPTVAL=$PIECE(INDDAT,"*",3)
+30 SET CSTCTR=$PIECE(INDDAT,"*",7)
+31 SET LNDOL=$PIECE(INDDAT,"*",6)
+32 SET INVVTYP=$PIECE(INDDAT,"*",8)
+33 SET TOTDOL=TOTDOL+LNDOL
+34 ; Count # of line items in Inv Pt
SET IN4=IN4+1
+35 ; Invt. Point
SET IN5=IN2
+36 SET STDDOL=STDDOL+$GET(^TMP($JOB,"PRCPLO2",IN1,IN2,IN3,1))
+37 SET ODIDOL=ODIDOL+$GET(^TMP($JOB,"PRCPLO2",IN1,IN2,IN3,2))
+38 QUIT
End DoDot:3
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 QUIT
GETVAL ; Get values from ^TMP($J,"PRCPSOH"
+1 NEW LP1,SOHIEN,PRCPDX
+2 SET LP1=0
+3 FOR
SET LP1=$ORDER(^TMP($JOB,"PRCPSOH",LP1))
if LP1=""
QUIT
Begin DoDot:1
+4 SET PRCPDX=$GET(^TMP($JOB,"PRCPSOH",LP1))
+5 SET SOHIEN=+LP1
+6 SET DR="1///"_PRCPDX
+7 DO SETREC
+8 SET PRCPDX=$GET(^TMP($JOB,"PRCPSOH2",LP1))
+9 SET DR="2///"_PRCPDX
+10 DO SETREC
+11 QUIT
End DoDot:1
+12 QUIT
SETREC ; Set record using DIE in 446.7
+1 ;
+2 NEW PRCPDR,PRCPST,PRCPSNM,PRCPDA,PRCPDX,PRCPST,X,Y
+3 SET PRCPDR=DR
+4 SET DIC="^PRCP(446.7,"
SET DIC(0)="L"
SET DLAYGO=446.7
SET X=SOHIEN
DO ^DIC
KILL DIC,DLAYGO
+5 SET PRCPDA=Y+0
+6 SET PRCPST=$PIECE(^TMP($JOB,"PRCPSOH",LP1),"*",1)
+7 SET PRCPSNM=$$GET1^DIQ(4,PRCPST_",",.01)
+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 Days of Stock on Hand Report, related data: "
+11 SET PRCPMSG(2)=""
SET PRCPMSG(3)="Station: "_PRCPST_" "_PRCPSNM
+12 SET PRCPMSG(4)="Inventory Point: "_$PIECE(^TMP($JOB,"PRCPSOH",LP1),"*",3)_" "_$PIECE(^TMP($JOB,"PRCPSOH",LP1),"*",4)
+13 SET PRCPMSG(5)="File #446.7 Field Set Attempted: "_PRCPDR
+14 DO MAIL^PRCPLO3
QUIT
End DoDot:1
QUIT
+15 ;
+16 SET DIE="^PRCP(446.7,"
SET DA=PRCPDA
DO ^DIE
KILL DIE,DR,DA
+17 QUIT
