- 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