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 Dec 13, 2024@01:51:31 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
