ACRFFF2 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF ITEMS ORDERED [ 10/27/2004 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
;
;
DESC ;----- ROUTINE DESCRIPTION
;;Create Items Ordered Flat File
;;
;;This option will gather all items ordered within the specified
;;date range for the specified object class code(s) and place them
;;into a comma delimited flat file which can then be imported
;;into an Access or Excel spreadsheet.
;;
;;Fields included in the flat file are:
;; Requisition Number
;; Document identifier
;; Purchase Order Number
;; Date of Purchase Order
;; Vendor Name
;; Order Number (Vendor or Part Number)
;; National Stock Number (NSN)
;; Description Lines 1-5
;; Quantity
;; Unit of Issue
;; Unit Cost
;; Object Class Code
;; Can Number
;; Fiscal Year of Funds
;; Department Account Name
;;$$END
;
EN ;EP -- MAIN ENTRY POINT
;
N ACRDATES,ACRFILE,ACRLOC,ACROCC,ACROUT
;
D ^XBKVAR
D HOME^%ZIS
;
D TXT
;
D DATE(.ACRDATES)
Q:$G(ACRDATES)']""
;
D OCC(.ACROCC)
Q:$G(ACROCC)']""
;
D LOC(.ACRLOC)
Q:'$G(ACRLOC)
;
D FILE(.ACRFILE)
Q:$G(ACRFILE)']""
;
W " please wait..."
;
D GET(ACRDATES,ACROCC,ACRLOC)
;
I '$D(^TMP("ACR",$J,"ITEMS")) D Q
. W !!,"No data found"
. D PAUSE^ACRFWARN
;
D UNIX(ACRFILE)
;
K ^TMP("ACR",$J,"ITEMS")
;
;D ^%ZISC ;ACR*2.1*13.01 IM13574
;
D PAUSE^ACRFWARN
;
Q
GET(ACRDATES,ACROCC,ACRLOC) ;
;----- LOOP THROUGH AND GET ORDERS
;
N ACRBEG,ACRDATA,ACRDATE,ACRDOCDA,ACREND,ACRREF
K ^TMP("ACR",$J,"ITEMS")
S ACRBEG=$P(ACRDATES,U)
S ACREND=$P(ACRDATES,U,2)
S ACRDATE=ACRBEG-1
F S ACRDATE=$O(^ACRDOC("DT",ACRDATE)) Q:'ACRDATE Q:ACRDATE>ACREND D
. S ACRDOCDA=0
. F S ACRDOCDA=$O(^ACRDOC("S",ACRDATE,ACRDOCDA)) Q:'ACRDOCDA D
. . S ACRDATA=$G(^ACRDOC(ACRDOCDA,0))
. . Q:$P(ACRDATA,U,14)["CANCELLED"
. . S ACRREF=$P(ACRDATA,U,13)
. . S ACRREF=$P($G(^AUTTDOCR(ACRREF,0)),U)
. . Q:"^116^103"'[ACRREF
. . S ACRLOCDA=$P(ACRDATA,U,6)
. . I ACRLOCDA S ACRLOCDA=$P($G(^ACRLOCB(ACRLOCDA,"DT")),U,11)
. . Q:ACRLOCDA'=ACRLOC
. . D ITEMS(ACRDOCDA,ACROCC,ACRDATE)
;
Q
ITEMS(ACRDOCDA,ACROCC,ACRDATE) ;
;----- GET PO ITEMS AND PUT IN ^TMP GLOBAL
;
N ACRCAN,ACRCOST,ACRDATA,ACRITMDA,ACRDEPT,ACRDESC1,ACRDESC2,ACRDESC3,ACRDESC4,ACRDESC5,ACRDOCNO,ACRNSN,ACROCCC,ACROCCDA,ACRORDNO,ACRPO,ACRQTY,ACRUI,ACRVEND,ACRID,ACRFY ;ACR*2.1*13.06 IM14144
S ACRITMDA=0
F S ACRITMDA=$O(^ACRSS("C",ACRDOCDA,ACRITMDA)) Q:'ACRITMDA D
. S ACRDATA=$G(^ACRSS(ACRITMDA,0))
. S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
. S ACROCCDA=$P(ACRDATA,U,4)
. Q:'ACROCCDA
. S ACROCCC=$P($G(^AUTTOBJC(ACROCCDA,0)),U)
. I $E(ACROCC,3,4)="00" Q:$E(ACROCCC,1,2)'=$E(ACROCC,1,2)
. I $E(ACROCC,3,4)'="00" Q:ACROCCC'=ACROCC
. S ACRCAN=$P(ACRDATA,U,5)
. S ACRCAN=$P($G(^AUTTCAN(ACRCAN,0)),U)
. S ACRDEPT=$P(ACRDATA,U,6)
. S ACRFY=$$FYFUN^ACRFUTL1(ACRDEPT) ;ACR*2.1*13.06 IM14144
. S ACRDEPT=$P($G(^ACRLOCB(ACRDEPT,0)),U,5)
. I ACRDEPT S ACRDEPT=$P($G(^AUTTPRG(ACRDEPT,0)),U)
. S ACRDATA=$G(^ACRSS(ACRITMDA,"DESC"))
. S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
. S ACRDESC1=$P(ACRDATA,U)
. S ACRDESC2=$P(ACRDATA,U,2)
. S ACRDESC3=$P(ACRDATA,U,3)
. S ACRDESC4=$P(ACRDATA,U,4)
. S ACRDESC5=$P(ACRDATA,U,5)
. S ACRDATA=$G(^ACRSS(ACRITMDA,"DT"))
. S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
. S ACRQTY=$P(ACRDATA,U)
. S ACRUI=$P(ACRDATA,U,2)
. I ACRUI S ACRUI=$P($G(^ACRUI(ACRUI,0)),U)
. S ACRCOST=$P(ACRDATA,U,3)
. S ACRDATA=$G(^ACRSS(ACRITMDA,"NMS"))
. S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
. S ACRORDNO=$P(ACRDATA,U)
. S ACRNSN=$P(ACRDATA,U,2)
. I ACRNSN']"" D
. . S ACRNSN=$P($G(^ACRSS(ACRITMDA,0)),U,12)
. . I ACRNSN S ACRNSN=$P($G(^ACRITEM(ACRNSN,"DT")),U,4)
. S ACRDATA=$G(^ACRDOC(ACRDOCDA,0))
. S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
. S ACRDOCNO=$P(ACRDATA,U)
. S ACRPO=$P(ACRDATA,U,2)
. S ACRID=$P(ACRDATA,U,14) ;ACR*2.1*13.06 IM14144
. S ACRVEND=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)
. I ACRVEND S ACRVEND=$P($G(^AUTTVNDR(ACRVEND,0)),U)
. ;S ^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)=ACRDOCNO_U_ACRPO_U_$$SLDATE^ACRFUTL(ACRDATE)_U_ACRVEND_U_ACRORDNO_U_ACRNSN_U_ACRDESC1_U_ACRDESC2_U_ACRDESC3_U_ACRDESC4_U_ACRDESC5 ;ACR*2.1*13.06 IM14144
. ;S ^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)=^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)_U_ACRQTY_U_ACRUI_U_$$DOL^ACRFUTL(ACRCOST)_U_ACROCCC_U_ACRCAN_U_ACRDEPT ;ACR*2.1*13.06 IM14144
. S ACRDATA=ACRDOCNO_U_ACRID_U_ACRPO_U_$$SLDATE^ACRFUTL(ACRDATE) ;ACR*2.1*13.06 IM14144
. S ACRDATA=ACRDATA_U_ACRVEND_U_ACRORDNO_U_ACRNSN_U_ACRDESC1 ;ACR*2.1*13.06 IM14144
. S ACRDATA=ACRDATA_U_ACRDESC2_U_ACRDESC3_U_ACRDESC4_U_ACRDESC5 ;ACR*2.1*13.06 IM14144
. S ACRDATA=ACRDATA_U_ACRQTY_U_ACRUI_U_$$DOL^ACRFUTL(ACRCOST) ;ACR*2.1*13.06 IM14144
. S ACRDATA=ACRDATA_U_ACROCCC_U_ACRCAN_U_ACRFY_U_ACRDEPT ;ACR*2.1*13.06 IM14144
. S ^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)=ACRDATA ;ACR*2.1*13.06 IM14144
Q
UNIX(ACRFILE) ;
;----- WRITE ^TMP GLOBAL TO FLAT FILE ;ACR*2.1*13.06 IM14144
;
;N %FILE,ACRCNT,ACRDOCDA,ACRITMDA,ACROUT,X ;ACR*2.1*13.06 IM14144
N %FILE,ACRCNT,ACRDOCDA,ACRITMDA,ACROUT,X,ACRDIR ;ACR*2.1*13.06 IM14144
Q:'$D(^TMP("ACR",$J,"ITEMS"))
;D HFS(.ACROUT,.%FILE,ACRFILE) ;ACR*2.1*13.06 IM14144
D HFS(.ACROUT,.%FILE,.ACRDIR,ACRFILE) ;ACR*2.1*13.06 IM14144
Q:$G(ACROUT)
U %FILE
S ACRCNT=0
S ACRDOCDA=0
F S ACRDOCDA=$O(^TMP("ACR",$J,"ITEMS",ACRDOCDA)) Q:'ACRDOCDA D
. S ACRITMDA=0
. F S ACRITMDA=$O(^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA)) Q:'ACRITMDA D
. . S X=$G(^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0))
. . S ACRCNT=$G(ACRCNT)+1
. . D WRITE(X)
. . W !
;U 0 W !!,ACRCNT_" Records have been put into UNIX file /usr/spool/afsdata/"_ACRFILE ; ACR*2.1*13.06 IM14144
;D ^%ZISC ; ACR*2.1*13.06 IM14144
U 0 W !!,ACRCNT_" Records have been put into file "_ACRDIR_ACRFILE ; ACR*2.1*13.06 IM14144
D CLOSE^ACRFZISH("FILE") ; ACR*2.1*13.06 IM14144
H 3
Q
WRITE(X) ;----- FORMAT AND WRITE DATA TO FLAT FILE ;ACR*2.1*13.06 IM14144
;
F I=1:1:$L(X,U) D
. S Y=$P(X,U,I)
. W """"
. W Y
. W """"
. W ","
Q
DATE(ACRDATES) ;
;----- ASK DATE RANGE
;
DLOOP ;----- DATE LOOP
;
N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="DO^::E"
S DIR("A")="Begin with ORDER DATE"
S DIR("?")="The date the order was placed"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S ACRBEG=Y
S DIR("A")="End with ORDER DATE"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S ACREND=Y
I ACREND<ACRBEG D G DLOOP
. W *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
S ACRDATES=ACRBEG_U_ACREND
Q
OCC(ACROCC) ;
;----- ASK OBJECT CLASS CODE RANGE
;
S DIR(0)="F^4:4"
S DIR("A")="Select OBJECT CLASS CODE or GROUP"
S DIR("?")="The OBJECT CLASS CODE or OBJECT CLASS CODE GROUP, e.g., 2600, 3100, 3200"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
S ACROCC=Y
Q
LOC(ACRLOC) ;
;----- ASK LOCATION CODE
;
S DIC="^AUTTLCOD("
S DIC(0)="AEMQ"
D ^DIC
Q:$D(DTOUT)!($D(DUOUT))
Q:Y'>0
S ACRLOC=+Y
Q
FILE(ACRFILE) ;
;----- ASK FILE NAME
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S ACRFILE=""
S DIR(0)="F"
;S DIR("A")="Select UNIX FILE NAME" ;ACR*2.1*13.06 IM14144
S DIR("A")="Select FILE NAME" ;ACR*2.1*13.06 IM14144
;S DIR("?")="The name of the UNIX file you want to put the data into" ;ACR*2.1*13.06 IM14144
S DIR("?")="The name of the file you want to put the data into" ;ACR*2.1*13.06 IM14144
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
S ACRFILE=Y_".csv"
Q
; HFS(ACROUT,%FILE,ACRFILE) ; OLD FHS: ; ACR*2.1*13.06 IM14144
;----- CREATE AND OPEN UNIX FILE
;
;N X,Y,ZISH1,ZISH2,ZISH3
;S ZISH1="/usr/spool/afsdata/"
;S ZISH2=ACRFILE
;S ZISH3="W"
;S Y=$$OPEN^ZISHMSMU(ZISH1,ZISH2,ZISH3)
;I Y D Q
;. W "CANNOT OPEN FILE "_ZISH1_ZISH2
;. S ACROUT=1
;S %FILE=IO
;Q
HFS(ACROUT,%FILE,ACRDIR,ACRFILE) ; ;ACR*2.1*13.06 IM14144
;----- CREATE AND OPEN FLAT FILE ;ACR*2.1*13.06 IM14144
;
N X,Y,ZISH2,ZISH3 ;ACR*2.1*13.06 IM14144
S ACRDIR=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*13.06 IM14144
Q:ACRDIR']"" ;ACR*2.1*13.06 IM14144
S ZISH2=ACRFILE ;ACR*2.1*13.06 IM14144
S ZISH3="W" ;ACR*2.1*13.01 IM13574
D HFS^ACRFZISH(ACRDIR,ZISH2,ZISH3,.%FILE) ;VERBOSE ;ACR*2.1*13.01 IM13574
I $G(%FILE)']"" S ACROUT=1 ;ACR*2.1*13.01 IM13574
Q
TXT ;----- PRINT OPTION TEXT
;
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
ACRFFF2 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF ITEMS ORDERED [ 10/27/2004 4:18 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
+2 ;
+3 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;Create Items Ordered Flat File
+2 ;;
+3 ;;This option will gather all items ordered within the specified
+4 ;;date range for the specified object class code(s) and place them
+5 ;;into a comma delimited flat file which can then be imported
+6 ;;into an Access or Excel spreadsheet.
+7 ;;
+8 ;;Fields included in the flat file are:
+9 ;; Requisition Number
+10 ;; Document identifier
+11 ;; Purchase Order Number
+12 ;; Date of Purchase Order
+13 ;; Vendor Name
+14 ;; Order Number (Vendor or Part Number)
+15 ;; National Stock Number (NSN)
+16 ;; Description Lines 1-5
+17 ;; Quantity
+18 ;; Unit of Issue
+19 ;; Unit Cost
+20 ;; Object Class Code
+21 ;; Can Number
+22 ;; Fiscal Year of Funds
+23 ;; Department Account Name
+24 ;;$$END
+25 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW ACRDATES,ACRFILE,ACRLOC,ACROCC,ACROUT
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 DO TXT
+8 ;
+9 DO DATE(.ACRDATES)
+10 IF $GET(ACRDATES)']""
QUIT
+11 ;
+12 DO OCC(.ACROCC)
+13 IF $GET(ACROCC)']""
QUIT
+14 ;
+15 DO LOC(.ACRLOC)
+16 IF '$GET(ACRLOC)
QUIT
+17 ;
+18 DO FILE(.ACRFILE)
+19 IF $GET(ACRFILE)']""
QUIT
+20 ;
+21 WRITE " please wait..."
+22 ;
+23 DO GET(ACRDATES,ACROCC,ACRLOC)
+24 ;
+25 IF '$DATA(^TMP("ACR",$JOB,"ITEMS"))
Begin DoDot:1
+26 WRITE !!,"No data found"
+27 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+28 ;
+29 DO UNIX(ACRFILE)
+30 ;
+31 KILL ^TMP("ACR",$JOB,"ITEMS")
+32 ;
+33 ;D ^%ZISC ;ACR*2.1*13.01 IM13574
+34 ;
+35 DO PAUSE^ACRFWARN
+36 ;
+37 QUIT
GET(ACRDATES,ACROCC,ACRLOC) ;
+1 ;----- LOOP THROUGH AND GET ORDERS
+2 ;
+3 NEW ACRBEG,ACRDATA,ACRDATE,ACRDOCDA,ACREND,ACRREF
+4 KILL ^TMP("ACR",$JOB,"ITEMS")
+5 SET ACRBEG=$PIECE(ACRDATES,U)
+6 SET ACREND=$PIECE(ACRDATES,U,2)
+7 SET ACRDATE=ACRBEG-1
+8 FOR
SET ACRDATE=$ORDER(^ACRDOC("DT",ACRDATE))
IF 'ACRDATE
QUIT
IF ACRDATE>ACREND
QUIT
Begin DoDot:1
+9 SET ACRDOCDA=0
+10 FOR
SET ACRDOCDA=$ORDER(^ACRDOC("S",ACRDATE,ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:2
+11 SET ACRDATA=$GET(^ACRDOC(ACRDOCDA,0))
+12 IF $PIECE(ACRDATA,U,14)["CANCELLED"
QUIT
+13 SET ACRREF=$PIECE(ACRDATA,U,13)
+14 SET ACRREF=$PIECE($GET(^AUTTDOCR(ACRREF,0)),U)
+15 IF "^116^103"'[ACRREF
QUIT
+16 SET ACRLOCDA=$PIECE(ACRDATA,U,6)
+17 IF ACRLOCDA
SET ACRLOCDA=$PIECE($GET(^ACRLOCB(ACRLOCDA,"DT")),U,11)
+18 IF ACRLOCDA'=ACRLOC
QUIT
+19 DO ITEMS(ACRDOCDA,ACROCC,ACRDATE)
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
ITEMS(ACRDOCDA,ACROCC,ACRDATE) ;
+1 ;----- GET PO ITEMS AND PUT IN ^TMP GLOBAL
+2 ;
+3 ;ACR*2.1*13.06 IM14144
NEW ACRCAN,ACRCOST,ACRDATA,ACRITMDA,ACRDEPT,ACRDESC1,ACRDESC2,ACRDESC3,ACRDESC4,ACRDESC5,ACRDOCNO,ACRNSN,ACROCCC,ACROCCDA,ACRORDNO,ACRPO,ACRQTY,ACRUI,ACRVEND,ACRID,ACRFY
+4 SET ACRITMDA=0
+5 FOR
SET ACRITMDA=$ORDER(^ACRSS("C",ACRDOCDA,ACRITMDA))
IF 'ACRITMDA
QUIT
Begin DoDot:1
+6 SET ACRDATA=$GET(^ACRSS(ACRITMDA,0))
+7 ;ACR*2.1*13.06 IM14144
SET ACRDATA=$TRANSLATE(ACRDATA,"""")
+8 SET ACROCCDA=$PIECE(ACRDATA,U,4)
+9 IF 'ACROCCDA
QUIT
+10 SET ACROCCC=$PIECE($GET(^AUTTOBJC(ACROCCDA,0)),U)
+11 IF $EXTRACT(ACROCC,3,4)="00"
IF $EXTRACT(ACROCCC,1,2)'=$EXTRACT(ACROCC,1,2)
QUIT
+12 IF $EXTRACT(ACROCC,3,4)'="00"
IF ACROCCC'=ACROCC
QUIT
+13 SET ACRCAN=$PIECE(ACRDATA,U,5)
+14 SET ACRCAN=$PIECE($GET(^AUTTCAN(ACRCAN,0)),U)
+15 SET ACRDEPT=$PIECE(ACRDATA,U,6)
+16 ;ACR*2.1*13.06 IM14144
SET ACRFY=$$FYFUN^ACRFUTL1(ACRDEPT)
+17 SET ACRDEPT=$PIECE($GET(^ACRLOCB(ACRDEPT,0)),U,5)
+18 IF ACRDEPT
SET ACRDEPT=$PIECE($GET(^AUTTPRG(ACRDEPT,0)),U)
+19 SET ACRDATA=$GET(^ACRSS(ACRITMDA,"DESC"))
+20 ;ACR*2.1*13.06 IM14144
SET ACRDATA=$TRANSLATE(ACRDATA,"""")
+21 SET ACRDESC1=$PIECE(ACRDATA,U)
+22 SET ACRDESC2=$PIECE(ACRDATA,U,2)
+23 SET ACRDESC3=$PIECE(ACRDATA,U,3)
+24 SET ACRDESC4=$PIECE(ACRDATA,U,4)
+25 SET ACRDESC5=$PIECE(ACRDATA,U,5)
+26 SET ACRDATA=$GET(^ACRSS(ACRITMDA,"DT"))
+27 ;ACR*2.1*13.06 IM14144
SET ACRDATA=$TRANSLATE(ACRDATA,"""")
+28 SET ACRQTY=$PIECE(ACRDATA,U)
+29 SET ACRUI=$PIECE(ACRDATA,U,2)
+30 IF ACRUI
SET ACRUI=$PIECE($GET(^ACRUI(ACRUI,0)),U)
+31 SET ACRCOST=$PIECE(ACRDATA,U,3)
+32 SET ACRDATA=$GET(^ACRSS(ACRITMDA,"NMS"))
+33 ;ACR*2.1*13.06 IM14144
SET ACRDATA=$TRANSLATE(ACRDATA,"""")
+34 SET ACRORDNO=$PIECE(ACRDATA,U)
+35 SET ACRNSN=$PIECE(ACRDATA,U,2)
+36 IF ACRNSN']""
Begin DoDot:2
+37 SET ACRNSN=$PIECE($GET(^ACRSS(ACRITMDA,0)),U,12)
+38 IF ACRNSN
SET ACRNSN=$PIECE($GET(^ACRITEM(ACRNSN,"DT")),U,4)
End DoDot:2
+39 SET ACRDATA=$GET(^ACRDOC(ACRDOCDA,0))
+40 ;ACR*2.1*13.06 IM14144
SET ACRDATA=$TRANSLATE(ACRDATA,"""")
+41 SET ACRDOCNO=$PIECE(ACRDATA,U)
+42 SET ACRPO=$PIECE(ACRDATA,U,2)
+43 ;ACR*2.1*13.06 IM14144
SET ACRID=$PIECE(ACRDATA,U,14)
+44 SET ACRVEND=$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
+45 IF ACRVEND
SET ACRVEND=$PIECE($GET(^AUTTVNDR(ACRVEND,0)),U)
+46 ;S ^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)=ACRDOCNO_U_ACRPO_U_$$SLDATE^ACRFUTL(ACRDATE)_U_ACRVEND_U_ACRORDNO_U_ACRNSN_U_ACRDESC1_U_ACRDESC2_U_ACRDESC3_U_ACRDESC4_U_ACRDESC5 ;ACR*2.1*13.06 IM14144
+47 ;S ^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)=^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)_U_ACRQTY_U_ACRUI_U_$$DOL^ACRFUTL(ACRCOST)_U_ACROCCC_U_ACRCAN_U_ACRDEPT ;ACR*2.1*13.06 IM14144
+48 ;ACR*2.1*13.06 IM14144
SET ACRDATA=ACRDOCNO_U_ACRID_U_ACRPO_U_$$SLDATE^ACRFUTL(ACRDATE)
+49 ;ACR*2.1*13.06 IM14144
SET ACRDATA=ACRDATA_U_ACRVEND_U_ACRORDNO_U_ACRNSN_U_ACRDESC1
+50 ;ACR*2.1*13.06 IM14144
SET ACRDATA=ACRDATA_U_ACRDESC2_U_ACRDESC3_U_ACRDESC4_U_ACRDESC5
+51 ;ACR*2.1*13.06 IM14144
SET ACRDATA=ACRDATA_U_ACRQTY_U_ACRUI_U_$$DOL^ACRFUTL(ACRCOST)
+52 ;ACR*2.1*13.06 IM14144
SET ACRDATA=ACRDATA_U_ACROCCC_U_ACRCAN_U_ACRFY_U_ACRDEPT
+53 ;ACR*2.1*13.06 IM14144
SET ^TMP("ACR",$JOB,"ITEMS",ACRDOCDA,ACRITMDA,0)=ACRDATA
End DoDot:1
+54 QUIT
UNIX(ACRFILE) ;
+1 ;----- WRITE ^TMP GLOBAL TO FLAT FILE ;ACR*2.1*13.06 IM14144
+2 ;
+3 ;N %FILE,ACRCNT,ACRDOCDA,ACRITMDA,ACROUT,X ;ACR*2.1*13.06 IM14144
+4 ;ACR*2.1*13.06 IM14144
NEW %FILE,ACRCNT,ACRDOCDA,ACRITMDA,ACROUT,X,ACRDIR
+5 IF '$DATA(^TMP("ACR",$JOB,"ITEMS"))
QUIT
+6 ;D HFS(.ACROUT,.%FILE,ACRFILE) ;ACR*2.1*13.06 IM14144
+7 ;ACR*2.1*13.06 IM14144
DO HFS(.ACROUT,.%FILE,.ACRDIR,ACRFILE)
+8 IF $GET(ACROUT)
QUIT
+9 USE %FILE
+10 SET ACRCNT=0
+11 SET ACRDOCDA=0
+12 FOR
SET ACRDOCDA=$ORDER(^TMP("ACR",$JOB,"ITEMS",ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:1
+13 SET ACRITMDA=0
+14 FOR
SET ACRITMDA=$ORDER(^TMP("ACR",$JOB,"ITEMS",ACRDOCDA,ACRITMDA))
IF 'ACRITMDA
QUIT
Begin DoDot:2
+15 SET X=$GET(^TMP("ACR",$JOB,"ITEMS",ACRDOCDA,ACRITMDA,0))
+16 SET ACRCNT=$GET(ACRCNT)+1
+17 DO WRITE(X)
+18 WRITE !
End DoDot:2
End DoDot:1
+19 ;U 0 W !!,ACRCNT_" Records have been put into UNIX file /usr/spool/afsdata/"_ACRFILE ; ACR*2.1*13.06 IM14144
+20 ;D ^%ZISC ; ACR*2.1*13.06 IM14144
+21 ; ACR*2.1*13.06 IM14144
USE 0
WRITE !!,ACRCNT_" Records have been put into file "_ACRDIR_ACRFILE
+22 ; ACR*2.1*13.06 IM14144
DO CLOSE^ACRFZISH("FILE")
+23 HANG 3
+24 QUIT
WRITE(X) ;----- FORMAT AND WRITE DATA TO FLAT FILE ;ACR*2.1*13.06 IM14144
+1 ;
+2 FOR I=1:1:$LENGTH(X,U)
Begin DoDot:1
+3 SET Y=$PIECE(X,U,I)
+4 WRITE """"
+5 WRITE Y
+6 WRITE """"
+7 WRITE ","
End DoDot:1
+8 QUIT
DATE(ACRDATES) ;
+1 ;----- ASK DATE RANGE
+2 ;
DLOOP ;----- DATE LOOP
+1 ;
+2 NEW ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 WRITE !
+4 SET DIR(0)="DO^::E"
+5 SET DIR("A")="Begin with ORDER DATE"
+6 SET DIR("?")="The date the order was placed"
+7 DO ^DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+9 IF Y=""
QUIT
+10 SET ACRBEG=Y
+11 SET DIR("A")="End with ORDER DATE"
+12 DO ^DIR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+14 IF Y=""
QUIT
+15 SET ACREND=Y
+16 IF ACREND<ACRBEG
Begin DoDot:1
+17 WRITE *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
End DoDot:1
GOTO DLOOP
+18 SET ACRDATES=ACRBEG_U_ACREND
+19 QUIT
OCC(ACROCC) ;
+1 ;----- ASK OBJECT CLASS CODE RANGE
+2 ;
+3 SET DIR(0)="F^4:4"
+4 SET DIR("A")="Select OBJECT CLASS CODE or GROUP"
+5 SET DIR("?")="The OBJECT CLASS CODE or OBJECT CLASS CODE GROUP, e.g., 2600, 3100, 3200"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+8 SET ACROCC=Y
+9 QUIT
LOC(ACRLOC) ;
+1 ;----- ASK LOCATION CODE
+2 ;
+3 SET DIC="^AUTTLCOD("
+4 SET DIC(0)="AEMQ"
+5 DO ^DIC
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 IF Y'>0
QUIT
+8 SET ACRLOC=+Y
+9 QUIT
FILE(ACRFILE) ;
+1 ;----- ASK FILE NAME
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 SET ACRFILE=""
+5 SET DIR(0)="F"
+6 ;S DIR("A")="Select UNIX FILE NAME" ;ACR*2.1*13.06 IM14144
+7 ;ACR*2.1*13.06 IM14144
SET DIR("A")="Select FILE NAME"
+8 ;S DIR("?")="The name of the UNIX file you want to put the data into" ;ACR*2.1*13.06 IM14144
+9 ;ACR*2.1*13.06 IM14144
SET DIR("?")="The name of the file you want to put the data into"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+12 SET ACRFILE=Y_".csv"
+13 QUIT
+14 ; HFS(ACROUT,%FILE,ACRFILE) ; OLD FHS: ; ACR*2.1*13.06 IM14144
+15 ;----- CREATE AND OPEN UNIX FILE
+16 ;
+17 ;N X,Y,ZISH1,ZISH2,ZISH3
+18 ;S ZISH1="/usr/spool/afsdata/"
+19 ;S ZISH2=ACRFILE
+20 ;S ZISH3="W"
+21 ;S Y=$$OPEN^ZISHMSMU(ZISH1,ZISH2,ZISH3)
+22 ;I Y D Q
+23 ;. W "CANNOT OPEN FILE "_ZISH1_ZISH2
+24 ;. S ACROUT=1
+25 ;S %FILE=IO
+26 ;Q
HFS(ACROUT,%FILE,ACRDIR,ACRFILE) ; ;ACR*2.1*13.06 IM14144
+1 ;----- CREATE AND OPEN FLAT FILE ;ACR*2.1*13.06 IM14144
+2 ;
+3 ;ACR*2.1*13.06 IM14144
NEW X,Y,ZISH2,ZISH3
+4 ;ACR*2.1*13.06 IM14144
SET ACRDIR=$$ARMSDIR^ACRFSYS(1)
+5 ;ACR*2.1*13.06 IM14144
IF ACRDIR']""
QUIT
+6 ;ACR*2.1*13.06 IM14144
SET ZISH2=ACRFILE
+7 ;ACR*2.1*13.01 IM13574
SET ZISH3="W"
+8 ;VERBOSE ;ACR*2.1*13.01 IM13574
DO HFS^ACRFZISH(ACRDIR,ZISH2,ZISH3,.%FILE)
+9 ;ACR*2.1*13.01 IM13574
IF $GET(%FILE)']""
SET ACROUT=1
+10 QUIT
TXT ;----- PRINT OPTION TEXT
+1 ;
+2 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+3 QUIT
