source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHITX1.m@ 1078

Last change on this file since 1078 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1PRCHITX1 ;WOIFO/LKG-WRITING ITEM DATA FOR NIF TO DAT FILES ;12/27/04 17:58
2 ;;5.1;IFCAP;**75**;OCT 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;Writes .dat file of vendor and item information to host file
5 D EN^DDIOL("This option writes item information to the .dat file.")
6 D EN^DDIOL("It is recommended to queue this extract for a time of low user activity.",,"!!")
7 N %ZIS,ZTRTN,ZTDESC,PRCPHYS
8 K Y,DIR S DIR(0)="Y",DIR("A")="Include physical inventory count transactions in the analysis",DIR("B")="NO"
9 S DIR("?",1)="Answer 'YES' if you have a large number of items that have recently been"
10 S DIR("?",2)="added to your GIP inventory, but have not yet been received or issued."
11 S DIR("?")="Answer 'NO' to exclude slow moving stock from NIF processing."
12 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G ITX
13 S PRCPHYS=$S(Y=1:"Y",1:"N") K Y
14 S %ZIS="Q",%ZIS("A")="Host File Device: ",%ZIS("B")="PRC_WIDE_HOST_FILE"
15 D ^%ZIS G:POP ITX
16 I $D(IO("Q")) D Q
17 . S ZTRTN="COMPILE^PRCHITX1",ZTDESC="Item Extraction for NIF",ZTSAVE("PRCPHYS")=""
18 . D ^%ZTLOAD,HOME^%ZIS
19 . D EN^DDIOL("Task #"_ZTSK) K IO("Q"),ZTSK
20COMPILE ;invoke the item and vendor compile
21 N X,Y,PRCSTA,PRCV,PRCW,PRCX,PRCY,PRCZ
22 D IN^PRCHITX
23 S PRCSTA=$$GETSTATN^PRCHITX
24 U IO
25VENDOR ;Write vendor data
26 S PRCX=""
27 F S PRCX=$O(^TMP($J,"V",PRCX)) Q:PRCX="" D
28 . S PRCY=$G(^TMP($J,"V",PRCX)) Q:PRCY=""
29 . S PRCZ="6^9^"_PRCSTA_"^"_PRCX_"^"_$P(PRCY,"^")_"^"_$P(PRCY,"^",4)_"^"_$P(PRCY,"^",3)_"^"_$P(PRCY,"^",2)_"^"_$P(PRCY,"^",5)
30 . W PRCZ,!
31ITEM ;Write item data
32 S PRCX=""
33 F S PRCX=$O(^TMP($J,"I",PRCX)) Q:PRCX="" D
34 . S PRCY=$G(^TMP($J,"I",PRCX,0)) Q:PRCY=""
35 . S PRCZ="6^0^"_PRCSTA_"^"_$P(PRCY,"^",8)_"^"_PRCX_"^"_$$GETSDESC^PRCHITX(PRCX)_"^"
36 . W PRCZ
37 . S X=0,Y=1
38 . F S X=$O(^PRC(441,PRCX,1,X)) Q:X="" D
39 . . S PRCZ=$G(^PRC(441,PRCX,1,X,0)),PRCZ=$TR(PRCZ,"^") Q:PRCZ=""
40 . . W:Y>1 " " W PRCZ S Y=Y+1
41 . S PRCZ="^^"_$P(PRCY,"^",6)_"^"_$P(PRCY,"^",4)_"^" W PRCZ
42 . S PRCW=$G(^TMP($J,"I",PRCX,1)),PRCV=$P(PRCW,"^")
43 . S PRCZ=$P(PRCY,"^",5)_"^^"_PRCV_"^^^^"_$P(PRCW,"^",4)_"^0^"_$P(PRCW,"^",2)_"^"_$P(PRCW,"^",3)_"^"
44 . W PRCZ
45 . S PRCZ=$P(PRCY,"^",3)_"^"_$P(PRCW,"^",6)_"^^"_$P(PRCW,"^",5)
46 . W PRCZ,!
47 D ^%ZISC
48 S:$D(ZTQUEUED) ZTREQ="@"
49 D:'$D(ZTQUEUED) EN^DDIOL("<DONE>")
50 K PRCW,PRCX,PRCY,PRCZ S PRCW=$$KSP^XUPARAM("WHERE")
51 K XMZ,XMMG,XMDUZ,XMY,XMSUB,XMTEXT
52 S PRCX(1)="Record counts for NIF Item Extract File from Station "_PRCSTA
53 S PRCX(2)=" "
54 S PRCX(3)=" Number of items: "_$G(^TMP($J,"I"),0)
55 S PRCX(4)=" Number of vendors: "_$G(^TMP($J,"V"),0)
56 S PRCX(5)=" ",PRCX(6)="Physical count transactions were "_$S(PRCPHYS="Y":"",1:"not ")_"included in the analysis."
57 X ^%ZOSF("UCI") S PRCY=^%ZOSF("PROD") S:PRCY'["," Y=$P(Y,",")
58 I Y=PRCY,PRCW'["FO-",PRCW'["ISC-" S XMY("prchitem@va.gov")=""
59 I $G(DUZ)>0,$D(^VA(200,DUZ)) D
60 . N PRCNAME
61 . S XMY(DUZ)=""
62 . S PRCNAME("FILE")=200,PRCNAME("IENS")=DUZ_",",PRCNAME("FIELD")=.01
63 . S PRCX(7)=" ",PRCX(8)="The extraction process was run by "_$$NAMEFMT^XLFNAME(.PRCNAME,"G","M")_"."
64 S XMSUB="NIF Item Extract Statistics for Station "_PRCSTA
65 S XMDUZ="NIF ITEM EXTRACTOR"
66 S XMTEXT="PRCX(" D ^XMD
67 I $G(XMZ),'$D(ZTQUEUED) D EN^DDIOL("MailMan message #"_$G(XMZ)_" with extract statistics was sent.")
68 K XMZ,XMMG,XMDUZ,XMY,XMSUB,XMTEXT,PRCPHYS
69ITX ;EXIT
70 K POP,^TMP($J),DTOUT,DUOUT,DIRUT,DIROUT,Y
71 Q
Note: See TracBrowser for help on using the repository browser.