- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPLO2A.m
r613 r623 1 PRCPLO2A ;WOIFO/DAP-stock status report (cont) ; 1/26/06 12:00pm 2 V ;;5.1;IFCAP;**83,98,112**;Oct 20, 2000;Build 2 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ;External reference to $$GET1^DIQ(4, is supported by ICR# 10090 5 ; *112 changes by: VMP, Holloway,T. 6 ; 7 ENT ;*83 Building ^TMP with total result data, totaling logic pulled from PRCPRSS0 8 N PRCPIN,PRCPIN1,PRCPIN2,PRCPIN3,TOTVAL,TOTCLOS,TOTCLO1,TOTCLO2,SSRIEN 9 S U="^",STA=PRC("SITE"),INV=PRCP("I") 10 ; 11 SSR1 ;*98 First Stock Status Report data field set 12 ; 13 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,1)=STA ;Station # 14 S DATRN=$$FMTE^XLFDT(DATESTRT) 15 S DATRN1=$P(DATRN," ",1)_","_$P(DATRN," ",2) 16 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,2)=DATRN1 ;Date Range 17 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,3)=INARNG ;Inactivity Range 18 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,4)=INV ;Inventory Point # 19 ;*83 Retrieve external inventory point name and primary/secondary/ 20 ;warehouse indicator 21 S PRCPIN=$G(^PRCP(445,INV,0)) 22 I PRCPIN'="" S PRCPIN1=$P(PRCPIN,"^",1),PRCPIN2=$P(PRCPIN1,"-",2,99) 23 I PRCPIN'="" S PRCPIN3=$P(PRCPIN,"^",3) 24 I PRCPIN="" S PRCPIN2="",PRCPIN3="" 25 S PRCPIN2=$TR(PRCPIN2,"*","|") ; Needed due to "*" delimiter 26 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,5)=PRCPIN2 ;Inventory Point Name 27 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,6)=PRCPIN3 ;P/S/W Indicator 28 ; 29 S PRCPDX=$TR(^TMP($J,"PRCPSSR1",STA,INV),"^","*"),DR="3///"_PRCPDX 30 D FILE 31 ; 32 SSR2 ;*98 Second Stock Status Report data field set 33 ; 34 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,1,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+% 35 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,1)=TOTOPEN ;Std. Open Balance Total $ 36 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,2,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+% 37 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,2)=TOTOPEN ;ODI Open Balance Total $ 38 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,3,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+% 39 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,3)=TOTOPEN ;All Open Balance Total $ 40 ; 41 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,4)=+$G(^TMP($J,1,"REC","TOTAL")) 42 ;Std. Receipts Total $ 43 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,5)=+$G(^TMP($J,2,"REC","TOTAL")) 44 ;ODI Receipts Total $ 45 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,6)=+$G(^TMP($J,3,"REC","TOTAL")) 46 ;All Receipts Total $ 47 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,7)=+$G(^TMP($J,1,"ISS","TOTAL")) 48 ;Std. Usages Total $ 49 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,8)=+$G(^TMP($J,2,"ISS","TOTAL")) 50 ;ODI Usages Total $ 51 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,9)=+$G(^TMP($J,3,"ISS","TOTAL")) 52 ;All Usages Total $ 53 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,10)=+$G(^TMP($J,1,"ADJ","TOTAL")) 54 ;Std. Adjustments Total $ 55 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,11)=+$G(^TMP($J,2,"ADJ","TOTAL")) 56 ;ODI Adjustments Total $ 57 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,12)=+$G(^TMP($J,3,"ADJ","TOTAL")) 58 ;All Adjustments Total $ 59 ; 60 S PRCPDX=$TR(^TMP($J,"PRCPSSR2",STA,INV),"^","*"),DR="4///"_PRCPDX 61 D FILE 62 ; 63 SSR3 ;*98 Third Stock Status Report data field set 64 ; 65 S TOTCLOS=0 66 S TOTCLOS=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,1)+$G(^TMP($J,1,"REC","TOTAL")) 67 S TOTCLOS=TOTCLOS+$G(^TMP($J,1,"ISS","TOTAL"))+$G(^TMP($J,1,"ADJ","TOTAL")) 68 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,1)=TOTCLOS ;Std. Closing Bal Total $ 69 S TOTCLO1=0 70 S TOTCLO1=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,2)+$G(^TMP($J,2,"REC","TOTAL")) 71 S TOTCLO1=TOTCLO1+$G(^TMP($J,2,"ISS","TOTAL"))+$G(^TMP($J,2,"ADJ","TOTAL")) 72 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,2)=TOTCLO1 ;ODI Closing Bal Total $ 73 S TOTCLO2=0 74 S TOTCLO2=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,3)+$G(^TMP($J,3,"REC","TOTAL")) 75 S TOTCLO2=TOTCLO2+$G(^TMP($J,3,"ISS","TOTAL"))+$G(^TMP($J,3,"ADJ","TOTAL")) 76 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,3)=TOTCLO2 ;All Closing Bal Total $ 77 ; 78 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,4)=+$G(^TMP($J,1,"RECN","TOTAL")) 79 ;# Std. Receipts 80 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,5)=+$G(^TMP($J,2,"RECN","TOTAL")) 81 ;# ODI Receipts 82 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,6)=+$G(^TMP($J,3,"RECN","TOTAL")) 83 ;# All Receipts 84 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,7)=+$G(^TMP($J,1,"ISSN","TOTAL")) 85 ;# Std. Issues 86 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,8)=+$G(^TMP($J,2,"ISSN","TOTAL")) 87 ;# ODI Issues 88 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,9)=+$G(^TMP($J,3,"ISSN","TOTAL")) 89 ;# All Issues 90 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,10)=+$G(^TMP($J,1,"ADJN","TOTAL")) 91 ;# Std. Adjustments 92 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,11)=+$G(^TMP($J,2,"ADJN","TOTAL")) 93 ;# ODI Adjustments 94 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,12)=+$G(^TMP($J,3,"ADJN","TOTAL")) 95 ;# All Adjustments 96 ; 97 S PRCPDX=$TR(^TMP($J,"PRCPSSR3",STA,INV),"^","*"),DR="5///"_PRCPDX 98 D FILE 99 ; 100 SSR4 ;*98 Fourth Stock Status Report data field set 101 ; 102 ;*83 Turnover computation logic also pulled from PRCPRSS0 103 S DAYS=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+$E(DATESTRT,4,5)) 104 I DAYS=28 S %=(17+$E(DATESTRT))_$E(DATESTRT,2,3),DAYS=$S(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28) 105 ; 106 S %=($G(^TMP($J,1,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLOS:0,1:-%/TOTCLOS) 107 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,1)=$J(%,0,2) 108 ;Std. Turnover 109 S %=($G(^TMP($J,2,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO1:0,1:-%/TOTCLO1) 110 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,2)=$J(%,0,2) 111 ;ODI Turnover 112 S %=($G(^TMP($J,3,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO2:0,1:-%/TOTCLO2) 113 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,3)=$J(%,0,2) 114 ;All Turnover 115 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,4)=+$G(^TMP($J,1,"INACTN","TOTAL")) 116 ;# Std. Inactive 117 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,5)=+$G(^TMP($J,2,"INACTN","TOTAL")) 118 ;# ODI Inactive 119 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,6)=+$G(^TMP($J,3,"INACTN","TOTAL")) 120 ;# All Inactive 121 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,7)=+$G(^TMP($J,1,"INACT","TOTAL")) 122 ;Std Inactive Total $ 123 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,8)=+$G(^TMP($J,2,"INACT","TOTAL")) 124 ;ODI Inactive Total $ 125 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,9)=+$G(^TMP($J,3,"INACT","TOTAL")) 126 ;All Inactive Total $ 127 ; 128 S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"INACT","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL"))) 129 I %="" S %=0 130 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,10)=$J(%,0,2) 131 ;Std. Inactive % 132 S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"INACT","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL"))) 133 I %="" S %=0 134 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,11)=$J(%,0,2) 135 ;ODI Inactive % 136 S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"INACT","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL"))) 137 I %="" S %=0 138 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,12)=$J(%,0,2) 139 ;All Inactive % 140 ; 141 S PRCPDX=$TR(^TMP($J,"PRCPSSR4",STA,INV),"^","*"),DR="6///"_PRCPDX 142 D FILE 143 ; 144 SSR5 ;*98 Fifth Stock Status Report data field set 145 ; 146 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,1)=+$G(^TMP($J,1,"LONGN","TOTAL")) 147 ;# Std. Long Supply 148 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,2)=+$G(^TMP($J,2,"LONGN","TOTAL")) 149 ;# ODI Long Supply 150 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,3)=+$G(^TMP($J,3,"LONGN","TOTAL")) 151 ;# All Long Supply 152 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,4)=+$G(^TMP($J,1,"LONG","TOTAL")) 153 ;Std. Long Supply Total $ 154 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,5)=+$G(^TMP($J,2,"LONG","TOTAL")) 155 ;ODI Long Supply Total $ 156 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,6)=+$G(^TMP($J,3,"LONG","TOTAL")) 157 ;All Long Supply Total $ 158 ; 159 S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"LONG","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL"))) 160 I %="" S %=0 161 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,7)=$J(%,0,2) 162 ;Std. Long Supply % 163 S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"LONG","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL"))) 164 I %="" S %=0 165 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,8)=$J(%,0,2) 166 ;ODI Long Supply % 167 S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"LONG","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL"))) 168 I %="" S %=0 169 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,9)=$J(%,0,2) 170 ;All Long Supply % 171 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,10)=+$G(^TMP($J,1,"CNT","TOTAL")) 172 ;# Std. Items 173 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,11)=+$G(^TMP($J,2,"CNT","TOTAL")) 174 ;# On-Demand Items 175 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,12)=+$G(^TMP($J,3,"CNT","TOTAL")) 176 ;# All Items 177 ; 178 S PRCPDX=$TR(^TMP($J,"PRCPSSR5",STA,INV),"^","*"),DR="7///"_PRCPDX 179 D FILE 180 K Y 181 ; 182 Q 183 ; 184 ;*98 Created filing subroutine 185 FILE ; Subroutine that creates entries in File #446.7 fields as they 186 ; are created 187 ; 188 N PRCPDR,PRCPSNM,PRCPDA,PRCPDX,X,Y 189 S PRCPDR=DR 190 S SSRIEN=STA_INV 191 S DIC="^PRCP(446.7,",DIC(0)="L",DLAYGO=446.7,X=SSRIEN D ^DIC K DIC,DLAYGO 192 S PRCPDA=Y+0 193 ;*98 Send enhanced mail message if exception occurs during FileMan set 194 I Y=-1 N PRCPMSG D Q 195 . S PRCPMSG(1)="Error saving to File #446.7 for Stock Status Report, related data: " 196 . S PRCPSNM=$$GET1^DIQ(4,STA_",",.01) 197 . S PRCPMSG(2)="",PRCPMSG(3)="Station: "_STA_" "_PRCPSNM 198 . S PRCPMSG(4)="Inventory Point: "_$P(^TMP($J,"PRCPSSR1",STA,INV),U,4)_" "_$P(^TMP($J,"PRCPSSR1",STA,INV),U,5) 199 . S PRCPMSG(5)="File #446.7 Field Set Attempted: "_PRCPDR 200 . D MAIL^PRCPLO3 Q 201 ; 202 S DIE="^PRCP(446.7,",DA=PRCPDA D ^DIE K DIE,DR,DA 203 ; 204 Q 1 PRCPLO2A ;WOIFO/DAP-stock status report (cont) ; 1/26/06 12:00pm 2 V ;;5.1;IFCAP;**83,98**;Oct 20, 2000;Build 37 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ENT ;*83 Building ^TMP with total result data, totaling logic pulled from PRCPRSS0 6 N PRCPIN,PRCPIN1,PRCPIN2,PRCPIN3,TOTVAL,TOTCLOS,TOTCLO1,TOTCLO2,SSRIEN 7 S U="^",STA=PRC("SITE"),INV=PRCP("I") 8 ; 9 SSR1 ;*98 First Stock Status Report data field set 10 ; 11 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,1)=STA ;Station # 12 S DATRN=$$FMTE^XLFDT(DATESTRT) 13 S DATRN1=$P(DATRN," ",1)_","_$P(DATRN," ",2) 14 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,2)=DATRN1 ;Date Range 15 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,3)=INARNG ;Inactivity Range 16 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,4)=INV ;Inventory Point # 17 ;*83 Retrieve external inventory point name and primary/secondary/ 18 ;warehouse indicator 19 S PRCPIN=$G(^PRCP(445,INV,0)) 20 I PRCPIN'="" S PRCPIN1=$P(PRCPIN,"^",1),PRCPIN2=$P(PRCPIN1,"-",2,99) 21 I PRCPIN'="" S PRCPIN3=$P(PRCPIN,"^",3) 22 I PRCPIN="" S PRCPIN2="",PRCPIN3="" 23 S PRCPIN2=$TR(PRCPIN2,"*","|") ; Needed due to "*" delimiter 24 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,5)=PRCPIN2 ;Inventory Point Name 25 S $P(^TMP($J,"PRCPSSR1",STA,INV),U,6)=PRCPIN3 ;P/S/W Indicator 26 ; 27 S PRCPDX=$TR(^TMP($J,"PRCPSSR1",STA,INV),"^","*"),DR="3///"_PRCPDX 28 D FILE 29 ; 30 SSR2 ;*98 Second Stock Status Report data field set 31 ; 32 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,1,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+% 33 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,1)=TOTOPEN ;Std. Open Balance Total $ 34 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,2,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+% 35 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,2)=TOTOPEN ;ODI Open Balance Total $ 36 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,3,"OPEN",ACCT)),U,2),TOTOPEN=TOTOPEN+% 37 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,3)=TOTOPEN ;All Open Balance Total $ 38 ; 39 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,4)=+$G(^TMP($J,1,"REC","TOTAL")) 40 ;Std. Receipts Total $ 41 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,5)=+$G(^TMP($J,2,"REC","TOTAL")) 42 ;ODI Receipts Total $ 43 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,6)=+$G(^TMP($J,3,"REC","TOTAL")) 44 ;All Receipts Total $ 45 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,7)=+$G(^TMP($J,1,"ISS","TOTAL")) 46 ;Std. Usages Total $ 47 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,8)=+$G(^TMP($J,2,"ISS","TOTAL")) 48 ;ODI Usages Total $ 49 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,9)=+$G(^TMP($J,3,"ISS","TOTAL")) 50 ;All Usages Total $ 51 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,10)=+$G(^TMP($J,1,"ADJ","TOTAL")) 52 ;Std. Adjustments Total $ 53 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,11)=+$G(^TMP($J,2,"ADJ","TOTAL")) 54 ;ODI Adjustments Total $ 55 S $P(^TMP($J,"PRCPSSR2",STA,INV),U,12)=+$G(^TMP($J,3,"ADJ","TOTAL")) 56 ;All Adjustments Total $ 57 ; 58 S PRCPDX=$TR(^TMP($J,"PRCPSSR2",STA,INV),"^","*"),DR="4///"_PRCPDX 59 D FILE 60 ; 61 SSR3 ;*98 Third Stock Status Report data field set 62 ; 63 S TOTCLOS=0 64 S TOTCLOS=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,1)+$G(^TMP($J,1,"REC","TOTAL")) 65 S TOTCLOS=TOTCLOS+$G(^TMP($J,1,"ISS","TOTAL"))+$G(^TMP($J,1,"ADJ","TOTAL")) 66 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,1)=TOTCLOS ;Std. Closing Bal Total $ 67 S TOTCLO1=0 68 S TOTCLO1=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,2)+$G(^TMP($J,2,"REC","TOTAL")) 69 S TOTCLO1=TOTCLO1+$G(^TMP($J,2,"ISS","TOTAL"))+$G(^TMP($J,2,"ADJ","TOTAL")) 70 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,2)=TOTCLO1 ;ODI Closing Bal Total $ 71 S TOTCLO2=0 72 S TOTCLO2=$P($G(^TMP($J,"PRCPSSR2",STA,INV)),U,3)+$G(^TMP($J,3,"REC","TOTAL")) 73 S TOTCLO2=TOTCLO2+$G(^TMP($J,3,"ISS","TOTAL"))+$G(^TMP($J,3,"ADJ","TOTAL")) 74 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,3)=TOTCLO2 ;All Closing Bal Total $ 75 ; 76 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,4)=+$G(^TMP($J,1,"RECN","TOTAL")) 77 ;# Std. Receipts 78 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,5)=+$G(^TMP($J,2,"RECN","TOTAL")) 79 ;# ODI Receipts 80 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,6)=+$G(^TMP($J,3,"RECN","TOTAL")) 81 ;# All Receipts 82 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,7)=+$G(^TMP($J,1,"ISSN","TOTAL")) 83 ;# Std. Issues 84 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,8)=+$G(^TMP($J,2,"ISSN","TOTAL")) 85 ;# ODI Issues 86 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,9)=+$G(^TMP($J,3,"ISSN","TOTAL")) 87 ;# All Issues 88 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,10)=+$G(^TMP($J,1,"ADJN","TOTAL")) 89 ;# Std. Adjustments 90 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,11)=+$G(^TMP($J,2,"ADJN","TOTAL")) 91 ;# ODI Adjustments 92 S $P(^TMP($J,"PRCPSSR3",STA,INV),U,12)=+$G(^TMP($J,3,"ADJN","TOTAL")) 93 ;# All Adjustments 94 ; 95 S PRCPDX=$TR(^TMP($J,"PRCPSSR3",STA,INV),"^","*"),DR="5///"_PRCPDX 96 D FILE 97 ; 98 SSR4 ;*98 Fourth Stock Status Report data field set 99 ; 100 ;*83 Turnover computation logic also pulled from PRCPRSS0 101 S DAYS=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+$E(DATESTRT,4,5)) 102 I DAYS=28 S %=(17+$E(DATESTRT))_$E(DATESTRT,2,3),DAYS=$S(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28) 103 ; 104 S %=($G(^TMP($J,1,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLOS:0,1:-%/TOTCLOS) 105 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 106 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,1)=% 107 ;Std. Turnover 108 S %=($G(^TMP($J,2,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO1:0,1:-%/TOTCLO1) 109 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 110 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,2)=% 111 ;ODI Turnover 112 S %=($G(^TMP($J,3,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO2:0,1:-%/TOTCLO2) 113 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 114 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,3)=% 115 ;All Turnover 116 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,4)=+$G(^TMP($J,1,"INACTN","TOTAL")) 117 ;# Std. Inactive 118 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,5)=+$G(^TMP($J,2,"INACTN","TOTAL")) 119 ;# ODI Inactive 120 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,6)=+$G(^TMP($J,3,"INACTN","TOTAL")) 121 ;# All Inactive 122 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,7)=+$G(^TMP($J,1,"INACT","TOTAL")) 123 ;Std Inactive Total $ 124 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,8)=+$G(^TMP($J,2,"INACT","TOTAL")) 125 ;ODI Inactive Total $ 126 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,9)=+$G(^TMP($J,3,"INACT","TOTAL")) 127 ;All Inactive Total $ 128 ; 129 S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"INACT","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL"))) 130 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 131 I %="" S %=0 132 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,10)=% 133 ;Std. Inactive % 134 S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"INACT","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL"))) 135 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 136 I %="" S %=0 137 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,11)=% 138 ;ODI Inactive % 139 S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"INACT","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL"))) 140 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 141 I %="" S %=0 142 S $P(^TMP($J,"PRCPSSR4",STA,INV),U,12)=% 143 ;All Inactive % 144 ; 145 S PRCPDX=$TR(^TMP($J,"PRCPSSR4",STA,INV),"^","*"),DR="6///"_PRCPDX 146 D FILE 147 ; 148 SSR5 ;*98 Fifth Stock Status Report data field set 149 ; 150 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,1)=+$G(^TMP($J,1,"LONGN","TOTAL")) 151 ;# Std. Long Supply 152 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,2)=+$G(^TMP($J,2,"LONGN","TOTAL")) 153 ;# ODI Long Supply 154 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,3)=+$G(^TMP($J,3,"LONGN","TOTAL")) 155 ;# All Long Supply 156 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,4)=+$G(^TMP($J,1,"LONG","TOTAL")) 157 ;Std. Long Supply Total $ 158 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,5)=+$G(^TMP($J,2,"LONG","TOTAL")) 159 ;ODI Long Supply Total $ 160 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,6)=+$G(^TMP($J,3,"LONG","TOTAL")) 161 ;All Long Supply Total $ 162 ; 163 S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"LONG","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL"))) 164 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 165 I %="" S %=0 166 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,7)=% 167 ;Std. Long Supply % 168 S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"LONG","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL"))) 169 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 170 I %="" S %=0 171 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,8)=% 172 ;ODI Long Supply % 173 S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"LONG","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL"))) 174 I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2) 175 I %="" S %=0 176 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,9)=% 177 ;All Long Supply % 178 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,10)=+$G(^TMP($J,1,"CNT","TOTAL")) 179 ;# Std. Items 180 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,11)=+$G(^TMP($J,2,"CNT","TOTAL")) 181 ;# On-Demand Items 182 S $P(^TMP($J,"PRCPSSR5",STA,INV),U,12)=+$G(^TMP($J,3,"CNT","TOTAL")) 183 ;# All Items 184 ; 185 S PRCPDX=$TR(^TMP($J,"PRCPSSR5",STA,INV),"^","*"),DR="7///"_PRCPDX 186 D FILE 187 K Y 188 ; 189 Q 190 ; 191 ;*98 Created filing subroutine 192 FILE ; Subroutine that creates entries in File #446.7 fields as they 193 ; are created 194 ; 195 N PRCPDR,PRCPSNM,PRCPDA,PRCPDX,X,Y 196 S PRCPDR=DR 197 S SSRIEN=STA_INV 198 S DIC="^PRCP(446.7,",DIC(0)="L",DLAYGO=446.7,X=SSRIEN D ^DIC K DIC,DLAYGO 199 S PRCPDA=Y+0 200 ;*98 Send enhanced mail message if exception occurs during FileMan set 201 I Y=-1 N PRCPMSG D Q 202 . S PRCPMSG(1)="Error saving to File #446.7 for Stock Status Report, related data: " 203 . S PRCPSNM=$$GET1^DIQ(4,STA_",",.01) 204 . S PRCPMSG(2)="",PRCPMSG(3)="Station: "_STA_" "_PRCPSNM 205 . S PRCPMSG(4)="Inventory Point: "_$P(^TMP($J,"PRCPSSR1",STA,INV),U,4)_" "_$P(^TMP($J,"PRCPSSR1",STA,INV),U,5) 206 . S PRCPMSG(5)="File #446.7 Field Set Attempted: "_PRCPDR 207 . D MAIL^PRCPLO3 Q 208 ; 209 S DIE="^PRCP(446.7,",DA=PRCPDA D ^DIE K DIE,DR,DA 210 ; 211 Q
Note:
See TracChangeset
for help on using the changeset viewer.
