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