Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFFF2

ACRFFF2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. DESC ;----- ROUTINE DESCRIPTION
  1. ;;Create Items Ordered Flat File
  1. ;;
  1. ;;This option will gather all items ordered within the specified
  1. ;;date range for the specified object class code(s) and place them
  1. ;;into a comma delimited flat file which can then be imported
  1. ;;into an Access or Excel spreadsheet.
  1. ;;
  1. ;;Fields included in the flat file are:
  1. ;; Requisition Number
  1. ;; Document identifier
  1. ;; Purchase Order Number
  1. ;; Date of Purchase Order
  1. ;; Vendor Name
  1. ;; Order Number (Vendor or Part Number)
  1. ;; National Stock Number (NSN)
  1. ;; Description Lines 1-5
  1. ;; Quantity
  1. ;; Unit of Issue
  1. ;; Unit Cost
  1. ;; Object Class Code
  1. ;; Can Number
  1. ;; Fiscal Year of Funds
  1. ;; Department Account Name
  1. ;;$$END
  1. ;
  1. EN ;EP -- MAIN ENTRY POINT
  1. ;
  1. N ACRDATES,ACRFILE,ACRLOC,ACROCC,ACROUT
  1. ;
  1. D ^XBKVAR
  1. D HOME^%ZIS
  1. ;
  1. D TXT
  1. ;
  1. D DATE(.ACRDATES)
  1. Q:$G(ACRDATES)']""
  1. ;
  1. D OCC(.ACROCC)
  1. Q:$G(ACROCC)']""
  1. ;
  1. D LOC(.ACRLOC)
  1. Q:'$G(ACRLOC)
  1. ;
  1. D FILE(.ACRFILE)
  1. Q:$G(ACRFILE)']""
  1. ;
  1. W " please wait..."
  1. ;
  1. D GET(ACRDATES,ACROCC,ACRLOC)
  1. ;
  1. I '$D(^TMP("ACR",$J,"ITEMS")) D Q
  1. . W !!,"No data found"
  1. . D PAUSE^ACRFWARN
  1. ;
  1. D UNIX(ACRFILE)
  1. ;
  1. K ^TMP("ACR",$J,"ITEMS")
  1. ;
  1. ;D ^%ZISC ;ACR*2.1*13.01 IM13574
  1. ;
  1. D PAUSE^ACRFWARN
  1. ;
  1. Q
  1. GET(ACRDATES,ACROCC,ACRLOC) ;
  1. ;----- LOOP THROUGH AND GET ORDERS
  1. ;
  1. N ACRBEG,ACRDATA,ACRDATE,ACRDOCDA,ACREND,ACRREF
  1. K ^TMP("ACR",$J,"ITEMS")
  1. S ACRBEG=$P(ACRDATES,U)
  1. S ACREND=$P(ACRDATES,U,2)
  1. S ACRDATE=ACRBEG-1
  1. F S ACRDATE=$O(^ACRDOC("DT",ACRDATE)) Q:'ACRDATE Q:ACRDATE>ACREND D
  1. . S ACRDOCDA=0
  1. . F S ACRDOCDA=$O(^ACRDOC("S",ACRDATE,ACRDOCDA)) Q:'ACRDOCDA D
  1. . . S ACRDATA=$G(^ACRDOC(ACRDOCDA,0))
  1. . . Q:$P(ACRDATA,U,14)["CANCELLED"
  1. . . S ACRREF=$P(ACRDATA,U,13)
  1. . . S ACRREF=$P($G(^AUTTDOCR(ACRREF,0)),U)
  1. . . Q:"^116^103"'[ACRREF
  1. . . S ACRLOCDA=$P(ACRDATA,U,6)
  1. . . I ACRLOCDA S ACRLOCDA=$P($G(^ACRLOCB(ACRLOCDA,"DT")),U,11)
  1. . . Q:ACRLOCDA'=ACRLOC
  1. . . D ITEMS(ACRDOCDA,ACROCC,ACRDATE)
  1. ;
  1. Q
  1. ITEMS(ACRDOCDA,ACROCC,ACRDATE) ;
  1. ;----- GET PO ITEMS AND PUT IN ^TMP GLOBAL
  1. ;
  1. 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
  1. S ACRITMDA=0
  1. F S ACRITMDA=$O(^ACRSS("C",ACRDOCDA,ACRITMDA)) Q:'ACRITMDA D
  1. . S ACRDATA=$G(^ACRSS(ACRITMDA,0))
  1. . S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
  1. . S ACROCCDA=$P(ACRDATA,U,4)
  1. . Q:'ACROCCDA
  1. . S ACROCCC=$P($G(^AUTTOBJC(ACROCCDA,0)),U)
  1. . I $E(ACROCC,3,4)="00" Q:$E(ACROCCC,1,2)'=$E(ACROCC,1,2)
  1. . I $E(ACROCC,3,4)'="00" Q:ACROCCC'=ACROCC
  1. . S ACRCAN=$P(ACRDATA,U,5)
  1. . S ACRCAN=$P($G(^AUTTCAN(ACRCAN,0)),U)
  1. . S ACRDEPT=$P(ACRDATA,U,6)
  1. . S ACRFY=$$FYFUN^ACRFUTL1(ACRDEPT) ;ACR*2.1*13.06 IM14144
  1. . S ACRDEPT=$P($G(^ACRLOCB(ACRDEPT,0)),U,5)
  1. . I ACRDEPT S ACRDEPT=$P($G(^AUTTPRG(ACRDEPT,0)),U)
  1. . S ACRDATA=$G(^ACRSS(ACRITMDA,"DESC"))
  1. . S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
  1. . S ACRDESC1=$P(ACRDATA,U)
  1. . S ACRDESC2=$P(ACRDATA,U,2)
  1. . S ACRDESC3=$P(ACRDATA,U,3)
  1. . S ACRDESC4=$P(ACRDATA,U,4)
  1. . S ACRDESC5=$P(ACRDATA,U,5)
  1. . S ACRDATA=$G(^ACRSS(ACRITMDA,"DT"))
  1. . S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
  1. . S ACRQTY=$P(ACRDATA,U)
  1. . S ACRUI=$P(ACRDATA,U,2)
  1. . I ACRUI S ACRUI=$P($G(^ACRUI(ACRUI,0)),U)
  1. . S ACRCOST=$P(ACRDATA,U,3)
  1. . S ACRDATA=$G(^ACRSS(ACRITMDA,"NMS"))
  1. . S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
  1. . S ACRORDNO=$P(ACRDATA,U)
  1. . S ACRNSN=$P(ACRDATA,U,2)
  1. . I ACRNSN']"" D
  1. . . S ACRNSN=$P($G(^ACRSS(ACRITMDA,0)),U,12)
  1. . . I ACRNSN S ACRNSN=$P($G(^ACRITEM(ACRNSN,"DT")),U,4)
  1. . S ACRDATA=$G(^ACRDOC(ACRDOCDA,0))
  1. . S ACRDATA=$TR(ACRDATA,"""") ;ACR*2.1*13.06 IM14144
  1. . S ACRDOCNO=$P(ACRDATA,U)
  1. . S ACRPO=$P(ACRDATA,U,2)
  1. . S ACRID=$P(ACRDATA,U,14) ;ACR*2.1*13.06 IM14144
  1. . S ACRVEND=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)
  1. . I ACRVEND S ACRVEND=$P($G(^AUTTVNDR(ACRVEND,0)),U)
  1. . ;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
  1. . ;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
  1. . S ACRDATA=ACRDOCNO_U_ACRID_U_ACRPO_U_$$SLDATE^ACRFUTL(ACRDATE) ;ACR*2.1*13.06 IM14144
  1. . S ACRDATA=ACRDATA_U_ACRVEND_U_ACRORDNO_U_ACRNSN_U_ACRDESC1 ;ACR*2.1*13.06 IM14144
  1. . S ACRDATA=ACRDATA_U_ACRDESC2_U_ACRDESC3_U_ACRDESC4_U_ACRDESC5 ;ACR*2.1*13.06 IM14144
  1. . S ACRDATA=ACRDATA_U_ACRQTY_U_ACRUI_U_$$DOL^ACRFUTL(ACRCOST) ;ACR*2.1*13.06 IM14144
  1. . S ACRDATA=ACRDATA_U_ACROCCC_U_ACRCAN_U_ACRFY_U_ACRDEPT ;ACR*2.1*13.06 IM14144
  1. . S ^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0)=ACRDATA ;ACR*2.1*13.06 IM14144
  1. Q
  1. UNIX(ACRFILE) ;
  1. ;----- WRITE ^TMP GLOBAL TO FLAT FILE ;ACR*2.1*13.06 IM14144
  1. ;
  1. ;N %FILE,ACRCNT,ACRDOCDA,ACRITMDA,ACROUT,X ;ACR*2.1*13.06 IM14144
  1. N %FILE,ACRCNT,ACRDOCDA,ACRITMDA,ACROUT,X,ACRDIR ;ACR*2.1*13.06 IM14144
  1. Q:'$D(^TMP("ACR",$J,"ITEMS"))
  1. ;D HFS(.ACROUT,.%FILE,ACRFILE) ;ACR*2.1*13.06 IM14144
  1. D HFS(.ACROUT,.%FILE,.ACRDIR,ACRFILE) ;ACR*2.1*13.06 IM14144
  1. Q:$G(ACROUT)
  1. U %FILE
  1. S ACRCNT=0
  1. S ACRDOCDA=0
  1. F S ACRDOCDA=$O(^TMP("ACR",$J,"ITEMS",ACRDOCDA)) Q:'ACRDOCDA D
  1. . S ACRITMDA=0
  1. . F S ACRITMDA=$O(^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA)) Q:'ACRITMDA D
  1. . . S X=$G(^TMP("ACR",$J,"ITEMS",ACRDOCDA,ACRITMDA,0))
  1. . . S ACRCNT=$G(ACRCNT)+1
  1. . . D WRITE(X)
  1. . . W !
  1. ;U 0 W !!,ACRCNT_" Records have been put into UNIX file /usr/spool/afsdata/"_ACRFILE ; ACR*2.1*13.06 IM14144
  1. ;D ^%ZISC ; ACR*2.1*13.06 IM14144
  1. U 0 W !!,ACRCNT_" Records have been put into file "_ACRDIR_ACRFILE ; ACR*2.1*13.06 IM14144
  1. D CLOSE^ACRFZISH("FILE") ; ACR*2.1*13.06 IM14144
  1. H 3
  1. Q
  1. WRITE(X) ;----- FORMAT AND WRITE DATA TO FLAT FILE ;ACR*2.1*13.06 IM14144
  1. ;
  1. F I=1:1:$L(X,U) D
  1. . S Y=$P(X,U,I)
  1. . W """"
  1. . W Y
  1. . W """"
  1. . W ","
  1. Q
  1. DATE(ACRDATES) ;
  1. ;----- ASK DATE RANGE
  1. ;
  1. DLOOP ;----- DATE LOOP
  1. ;
  1. N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. W !
  1. S DIR(0)="DO^::E"
  1. S DIR("A")="Begin with ORDER DATE"
  1. S DIR("?")="The date the order was placed"
  1. D ^DIR
  1. Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1. Q:Y=""
  1. S ACRBEG=Y
  1. S DIR("A")="End with ORDER DATE"
  1. D ^DIR
  1. Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1. Q:Y=""
  1. S ACREND=Y
  1. I ACREND<ACRBEG D G DLOOP
  1. . W *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
  1. S ACRDATES=ACRBEG_U_ACREND
  1. Q
  1. OCC(ACROCC) ;
  1. ;----- ASK OBJECT CLASS CODE RANGE
  1. ;
  1. S DIR(0)="F^4:4"
  1. S DIR("A")="Select OBJECT CLASS CODE or GROUP"
  1. S DIR("?")="The OBJECT CLASS CODE or OBJECT CLASS CODE GROUP, e.g., 2600, 3100, 3200"
  1. D ^DIR
  1. Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1. S ACROCC=Y
  1. Q
  1. LOC(ACRLOC) ;
  1. ;----- ASK LOCATION CODE
  1. ;
  1. S DIC="^AUTTLCOD("
  1. S DIC(0)="AEMQ"
  1. D ^DIC
  1. Q:$D(DTOUT)!($D(DUOUT))
  1. Q:Y'>0
  1. S ACRLOC=+Y
  1. Q
  1. FILE(ACRFILE) ;
  1. ;----- ASK FILE NAME
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S ACRFILE=""
  1. S DIR(0)="F"
  1. ;S DIR("A")="Select UNIX FILE NAME" ;ACR*2.1*13.06 IM14144
  1. S DIR("A")="Select FILE NAME" ;ACR*2.1*13.06 IM14144
  1. ;S DIR("?")="The name of the UNIX file you want to put the data into" ;ACR*2.1*13.06 IM14144
  1. S DIR("?")="The name of the file you want to put the data into" ;ACR*2.1*13.06 IM14144
  1. D ^DIR
  1. Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1. S ACRFILE=Y_".csv"
  1. Q
  1. ; HFS(ACROUT,%FILE,ACRFILE) ; OLD FHS: ; ACR*2.1*13.06 IM14144
  1. ;----- CREATE AND OPEN UNIX FILE
  1. ;
  1. ;N X,Y,ZISH1,ZISH2,ZISH3
  1. ;S ZISH1="/usr/spool/afsdata/"
  1. ;S ZISH2=ACRFILE
  1. ;S ZISH3="W"
  1. ;S Y=$$OPEN^ZISHMSMU(ZISH1,ZISH2,ZISH3)
  1. ;I Y D Q
  1. ;. W "CANNOT OPEN FILE "_ZISH1_ZISH2
  1. ;. S ACROUT=1
  1. ;S %FILE=IO
  1. ;Q
  1. HFS(ACROUT,%FILE,ACRDIR,ACRFILE) ; ;ACR*2.1*13.06 IM14144
  1. ;----- CREATE AND OPEN FLAT FILE ;ACR*2.1*13.06 IM14144
  1. ;
  1. N X,Y,ZISH2,ZISH3 ;ACR*2.1*13.06 IM14144
  1. S ACRDIR=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*13.06 IM14144
  1. Q:ACRDIR']"" ;ACR*2.1*13.06 IM14144
  1. S ZISH2=ACRFILE ;ACR*2.1*13.06 IM14144
  1. S ZISH3="W" ;ACR*2.1*13.01 IM13574
  1. D HFS^ACRFZISH(ACRDIR,ZISH2,ZISH3,.%FILE) ;VERBOSE ;ACR*2.1*13.01 IM13574
  1. I $G(%FILE)']"" S ACROUT=1 ;ACR*2.1*13.01 IM13574
  1. Q
  1. TXT ;----- PRINT OPTION TEXT
  1. ;
  1. F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
  1. Q