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

ENARG.m

Go to the documentation of this file.
  1. ENARG ;(WCIOFO)/JED,SAB-GATHER ARCHIVAL RECORDS ;10/12/1999
  1. ;;7.0;ENGINEERING;**40,50,63**;Aug 17, 1993
  1. ;CALLED BY ENAR1 ;CALLS ENARG1
  1. Q
  1. G ;GET SORT PARAMS
  1. D STA G:ENERR'=0 OUT D @ENRT D:ENERR=0 MSG I ENERR'=0 G OUT
  1. G1 W !!,*7,"IS IT O.K. TO PROCEED" S %=2 D YN^DICN G:%<0 G1
  1. I %=0 W !,"Proceeding will build a list of all records meeting the above criteria,",!,"and give you a count. This may take a considerable amount of time." G G1
  1. I %'=1 S ENERR="UNCONFIRMED PROCEED" G OUT
  1. D G^ENARG1,OUT Q
  1. ;;
  1. 1 ; WORK ORDERS
  1. D I Q:ENERR'=0
  1. S DIR(0)="Y",DIR("A")="Include all shops",DIR("B")="YES"
  1. S DIR("?",1)="You may archive for all shops, for selected shops, or for all shops except"
  1. S DIR("?")="selected shops."
  1. D ^DIR K DIR I $D(DIRUT) S ENERR="Shop Selection Failure" Q
  1. I Y S ENSHOP("ALL")=1,ENPARAM="ALL SHOPS" Q
  1. S DIR(0)="SM^I:Include selected shops;E:Exclude selected shops"
  1. S DIR("A",1)="You will next be asked to select one or more shops. Do you wish to archive"
  1. S DIR("A",2)="work orders for these shops (Include) or to archive work orders for all shops"
  1. S DIR("A")="except those selected (Exclude)",DIR("B")="Include"
  1. D ^DIR K DIR I $D(DIRUT)!("^I^E^"'[(U_Y_U)) S ENERR="Shop Selection Failure" Q
  1. I Y="I" S ENSHOP("INC")=1,ENSHOP("EXC")=0,ENPARAM="INCLUDE SELECTED SHOPS"
  1. E S ENSHOP("INC")=0,ENSHOP("EXC")=1,ENPARAM="EXCLUDE SELECTED SHOPS"
  1. W ! S DIC="^DIC(6922,",DIC(0)="AEQM",DIC("A")=$S(ENSHOP("INC"):"Shop to be INCLUDED in archiving: ",ENSHOP("EXC"):"Shop to be EXCLUDED from archiving: ",1:"") I DIC("A")="" S ENERR="Shop Selection Failure" Q
  1. F D ^DIC Q:Y'>0 S ENSHOP(+Y)=$P(Y,U,2)
  1. I $O(ENSHOP(0))'?1.N S ENERR="Shop Selection Failure" Q
  1. Q
  1. ;
  1. 2 ; 2162 ACCIDENT REPORTS
  1. D I S ENPARAM="NONE" Q
  1. 3 ;EQUIPMENT INV.
  1. S X=$$FMADD^XLFDT(DT,-365)
  1. S DIR(0)="D^:"_X_":EXP"
  1. S DIR("B")=$$FMTE^XLFDT(X)
  1. S DIR("A")="Archive Equipment dispositioned as of"
  1. D ^DIR K DIR I $D(DIRUT) S ENERR="DISPOSITION DATE SELECT" Q
  1. S ENTO=Y
  1. S DIR(0)="Y",DIR("A")="Include Accountable NX equipment",DIR("B")="YES"
  1. S DIR("?",1)="Answer NO to keep Accountable NX equipment from being"
  1. S DIR("?",2)="archived. Accountable NX equipment is equipment that"
  1. S DIR("?",3)="has its INVESTMENT CATEGORY field equal to either"
  1. S DIR("?",3)="CAPITALIZED/ACCOUNTABLE or NOT CAPITALIZED/ACCOUNTABLE."
  1. S DIR("?",6)=" "
  1. S DIR("?")="Enter YES or NO"
  1. D ^DIR K DIR I $D(DIRUT) S ENERR="ACCOUNTABLE NX SELECT" Q
  1. S ENEQ("A")=Y
  1. S DIR(0)="Y",DIR("A")="Include JCAHO Inventory equipment",DIR("B")="YES"
  1. S DIR("?",1)="Answer NO to keep JCAHO Inventory equipment from being"
  1. S DIR("?",2)="archived. JCAHO Inventory equipment is equipment whose"
  1. S DIR("?",3)="JCAHO field equals YES."
  1. S DIR("?",4)=" "
  1. S DIR("?")="Enter YES or NO"
  1. D ^DIR K DIR I $D(DIRUT) S ENERR="JCAHO INVENTORY SELECT" Q
  1. S ENEQ("J")=Y
  1. S ENPARAM=$S(ENEQ("A"):"INCL",1:"EXCL")_" ACCT NX, "
  1. S ENPARAM=ENPARAM_$S(ENEQ("J"):"INCL",1:"EXCL")_" JCAHO"
  1. S ENFR=""
  1. Q
  1. 4 ; PROJECTS
  1. S ENERR="Project Archiving is not supported."
  1. Q
  1. 5 ; CONTROL POINT TRANSACTIONS
  1. S ENERR="Control Point Activity transactions may be archived only thru IFCAP."
  1. Q
  1. ;
  1. STA ;PICK STATION
  1. I $D(^DIC(6910,1,0)),$P(^(0),"^",2)'="",$P(^(0),"^",1)'="" S ENSTA=$P(^(0),"^",2),ENSTAN=$P(^(0),"^",1) W !,"Station Number: ",ENSTA,!,"Is this correct" S %=1 D YN^DICN Q:%=1 G STA:%=0,P1:%=2 S ENERR="STATION NUMBER" Q
  1. P1 S DIC="^DIC(4,",DIC(0)="AEQN",DIC("A")="Select STATION NUMBER: ",D="B" D IX^DIC S:Y<0 ENERR="STATION NUMBER" K DIC("A") Q:ENERR'=0 S ENSTA=+Y,ENSTAN=$P(Y,"^",2) Q
  1. ;
  1. I ;INTERVAL SELECTION
  1. W !,"Do you wish to archive by fiscal YEAR or QUARTER (Y or Q) Y// " R ENR:DTIME S:ENR="" ENR="Y" S ENR=$E(ENR)
  1. G:"YQyq"[ENR I1 I ENR="?" D G I
  1. . W !!," Please enter 'Y' for YEAR or 'Q' for QUARTER (or '^' to abort)...",!
  1. S ENERR="INTERVAL SELECTION"
  1. Q
  1. ;
  1. I1 K ENFY,ENQT,ENFR,ENTO
  1. I "Yy"[ENR D ; by fiscal year
  1. . D FY Q:ENERR'=0
  1. . S ENFR=(ENFY-1700-1)_"1000",ENTO=(ENFY-1700)_"0930"
  1. I "Qq"[ENR D ; by quarter
  1. . D FY Q:ENERR'=0
  1. . D QTR Q:ENERR'=0
  1. . I ENQT=1 S ENFR=(ENFY-1700-1)_"1000",ENTO=$E(ENFR,1,3)_"1231"
  1. . I ENQT=2 S ENFR=(ENFY-1700)_"0100",ENTO=$E(ENFR,1,3)_"0331"
  1. . I ENQT=3 S ENFR=(ENFY-1700)_"0400",ENTO=$E(ENFR,1,3)_"0630"
  1. . I ENQT=4 S ENFR=(ENFY-1700)_"0700",ENTO=$E(ENFR,1,3)_"0930"
  1. Q
  1. ;
  1. FY ; ask fiscal year
  1. ; return ENFY or ENERR'=0
  1. N ENFYT
  1. S ENFYT=$E(DT,1,3)+1700+$E(DT,4) ; default fiscal year
  1. FY1 W !,"SELECT FISCAL YEAR (4 digits): ",ENFYT,"//"
  1. R ENFY:DTIME S:'$T ENFY="^" I $E(ENFY)="^" S ENERR="FISCAL YEAR" Q
  1. S:ENFY="" ENFY=ENFYT
  1. I ENFY'?4N!(ENFY<1900) D G FY1
  1. . W $C(7),!!," Please enter the FISCAL YEAR (Oct 1 thru Sep 30) in"
  1. . W !," four digit format. Work orders whose DATE COMPLETE is within"
  1. . W !," this FISCAL YEAR will be archived.",!
  1. Q
  1. ;
  1. QTR ; ask quarter
  1. ; return ENQT or ENERR'=0
  1. N ENQTT
  1. S ENQTT=$P("2^2^2^3^3^3^4^4^4^1^1^1",U,$E(DT,4,5)) ; default quarter
  1. QTR1 W !,"SELECT QUARTER (1, 2, 3, or 4): ",ENQTT,"//"
  1. R ENQT:DTIME S:'$T ENQT="^" I $E(ENQT)="^" S ENERR="FISCAL QUARTER" Q
  1. S:ENQT="" ENQT=ENQTT
  1. I ENQT'?1N!(ENQT<1)!(ENQT>4) D G QTR1
  1. . W $C(7),!!," Answer must be 1, 2, 3, or 4!",!
  1. Q
  1. ;
  1. MSG W !!,*7,"You have requested to locate all " S ENMSG="MSG"_ENRT D @ENMSG
  1. Q
  1. ;
  1. MSG1 W "work orders completed for " I $G(ENSHOP("ALL")) W "all shops " D MSGA Q
  1. S X=$S(ENSHOP("INC"):"the following shops:",1:"all shops EXCEPT:") W X
  1. S I=0 F S I=$O(ENSHOP(I)) Q:I'?1.N W !,?5,I,?10,ENSHOP(I)
  1. W ! D MSGA
  1. Q
  1. ;
  1. MSG2 W !,"2162 accident reports, whose occurrence date was" D MSGA
  1. Q
  1. ;
  1. MSG3 W "equipment records with a DISPOSITION DATE"
  1. W !,"prior to ",$$FMTE^XLFDT(ENTO),", "
  1. W $S(ENEQ("A"):"including",1:"excluding")," Accountable NX equipment and ",$S(ENEQ("J"):"including",1:"excluding")
  1. W !,"JCAHO Inventory equipment."
  1. Q
  1. ;
  1. MSGA W:$X>50 ! W "in Fiscal Year ",ENFY W:$D(ENQT) ", ",ENQT,$S(ENQT=1:"st",ENQT=2:"nd",ENQT=3:"rd",ENQT=4:"th",1:"error")," Quarter" W "." Q
  1. OUT K D,DIC,ENA,ENEQ,ENFR,ENFY,ENFYT,ENMSG,ENPARAM,ENSHOP,ENQT,ENQTT,ENR,ENSH,ENSTA,ENSTAN,ENTO,I,Y Q
  1. ;ENARG