ENFSA2 ;(WASH ISC)/JED-Accident Reports ;4.23.98
V ;;7.0;ENGINEERING;**48,51**;Aug 17, 1993
;CALLS FYQTS^ENLIB,FYSONLY^ENLIB,DIC, CALLED BY ENFSA1
INT ;GET INTERVAL
W @IOF,!!!,"This option will generate a summary by",ENHD
S F="",ENAR="ACCIDENT REPORT",ENQ="W !!,"" DO YOU WANT ALL "",ENH,""S LISTED? (Y/N)"" S %=2 D YN^DICN"
D:'$D(DT) DT^DICRW S U="^",S=";",O=$T(OPT) I $D(^DOPT($P(O,S,5),"VERSION")),($P($T(V),S,3)=^DOPT($P(O,S,5),"VERSION")) G IN
K ^DOPT($P(O,S,5))
F I=1:1 Q:$T(OPT+I)="" S ^DOPT($P(O,S,5),I,0)=$P($T(OPT+I),S,3),^DOPT($P(O,S,5),"B",$P($P($T(OPT+I),S,3),"^",1),I)=""
S K=I-1,^DOPT($P(O,S,5),0)=$P(O,S,4)_U_1_U_K_U_K K I,K,X S ^DOPT($P(O,S,5),"VERSION")=$P($T(V),S,3)
IN I $P(O,S,6)'="" D @($P(O,S,6))
PR S O=$T(OPT),S=";" S IOP="HOME" D ^%ZIS K IOP
D HDR F J=1:1 Q:'$D(^DOPT($P(O,S,5),J,0)) W !,?15,J,". ",$P(^DOPT($P(O,S,5),J,0),U,1)
RE S DIC("A")="Select "_$P($T(OPT),S,4)_": EXIT// ",DIC="^DOPT("_""""_$P($T(OPT),S,5)_""""_",",DIC(0)="AEQMN" D ^DIC G:X=""!(X=U) ABORT G:Y<0 RE K DIC,J,O D @($P($T(OPT+Y),S,4)) Q
;
HDR W !!!!,?12,"ACCIDENT REPORT INTERVAL",! Q
;
MN W ! D FYSONLY^ENLIB G:'$D(ENFY) ABORT D RDMNTH^ENLIB1 G:ENMN=-1 ABORT
S:$L(ENMN)=1 ENMN="0"_ENMN
N DELYR S DELYR=$E(DT,2,3)-ENFY,ENFR=$E(DT)+$S(DELYR>79:1,DELYR<-20:-1,1:0)_ENFY_ENMN_"01"
S ENTO=$$EOM^ENUTL(ENFR)
Q
;
QT D FYQTS^ENLIB G:'$D(ENQT) ABORT
N DELYR S DELYR=$E(DT,2,3)-ENFY,ENFY(3)=$E(DT)+$S(DELYR>79:1,DELYR<-20:-1,1:0)_ENFY
I ENQT=1 S ENFR=(ENFY(3)-1)_1001,ENTO=(ENFY(3)-1)_1231 Q
I ENQT=2 S ENFR=ENFY(3)_"0101",ENTO=ENFY(3)_"0331" Q
I ENQT=3 S ENFR=ENFY(3)_"0401",ENTO=ENFY(3)_"0630" Q
S ENFR=ENFY(3)_"0701",ENTO=ENFY(3)_"0930"
Q
;
YR D FYSONLY^ENLIB G:'$D(ENFY) ABORT
N DELYR S DELYR=$E(DT,2,3)-ENFY,ENFY(3)=$E(DT)+$S(DELYR>79:1,DELYR<-20:-1,1:0)_ENFY
S ENFR=(ENFY(3)-1)_1001,ENTO=ENFY(3)_"0930"
Q
;
AR S ENFR=0 Q
;
ABORT S F=1 W !!,"USER ABORT",*7,!,"<cr> to continue " R R:DTIME Q
;
OPT ;;ACCIDENT REPORTING MODULE;ACCIDENT REPORT INTERVAL;ENFSA1;
;;MONTHLY;MN
;;QUARTERLY;QT
;;YEARLY;YR
;;ALL REPORTS;AR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFSA2 2087 printed Apr 09, 2024@21:01:34 Page 2
ENFSA2 ;(WASH ISC)/JED-Accident Reports ;4.23.98
V ;;7.0;ENGINEERING;**48,51**;Aug 17, 1993
+1 ;CALLS FYQTS^ENLIB,FYSONLY^ENLIB,DIC, CALLED BY ENFSA1
INT ;GET INTERVAL
+1 WRITE @IOF,!!!,"This option will generate a summary by",ENHD
+2 SET F=""
SET ENAR="ACCIDENT REPORT"
SET ENQ="W !!,"" DO YOU WANT ALL "",ENH,""S LISTED? (Y/N)"" S %=2 D YN^DICN"
+3 if '$DATA(DT)
DO DT^DICRW
SET U="^"
SET S=";"
SET O=$TEXT(OPT)
IF $DATA(^DOPT($PIECE(O,S,5),"VERSION"))
IF ($PIECE($TEXT(V),S,3)=^DOPT($PIECE(O,S,5),"VERSION"))
GOTO IN
+4 KILL ^DOPT($PIECE(O,S,5))
+5 FOR I=1:1
if $TEXT(OPT+I)=""
QUIT
SET ^DOPT($PIECE(O,S,5),I,0)=$PIECE($TEXT(OPT+I),S,3)
SET ^DOPT($PIECE(O,S,5),"B",$PIECE($PIECE($TEXT(OPT+I),S,3),"^",1),I)=""
+6 SET K=I-1
SET ^DOPT($PIECE(O,S,5),0)=$PIECE(O,S,4)_U_1_U_K_U_K
KILL I,K,X
SET ^DOPT($PIECE(O,S,5),"VERSION")=$PIECE($TEXT(V),S,3)
IN IF $PIECE(O,S,6)'=""
DO @($PIECE(O,S,6))
PR SET O=$TEXT(OPT)
SET S=";"
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+1 DO HDR
FOR J=1:1
if '$DATA(^DOPT($PIECE(O,S,5),J,0))
QUIT
WRITE !,?15,J,". ",$PIECE(^DOPT($PIECE(O,S,5),J,0),U,1)
RE SET DIC("A")="Select "_$PIECE($TEXT(OPT),S,4)_": EXIT// "
SET DIC="^DOPT("_""""_$PIECE($TEXT(OPT),S,5)_""""_","
SET DIC(0)="AEQMN"
DO ^DIC
if X=""!(X=U)
GOTO ABORT
if Y<0
GOTO RE
KILL DIC,J,O
DO @($PIECE($TEXT(OPT+Y),S,4))
QUIT
+1 ;
HDR WRITE !!!!,?12,"ACCIDENT REPORT INTERVAL",!
QUIT
+1 ;
MN WRITE !
DO FYSONLY^ENLIB
if '$DATA(ENFY)
GOTO ABORT
DO RDMNTH^ENLIB1
if ENMN=-1
GOTO ABORT
+1 if $LENGTH(ENMN)=1
SET ENMN="0"_ENMN
+2 NEW DELYR
SET DELYR=$EXTRACT(DT,2,3)-ENFY
SET ENFR=$EXTRACT(DT)+$SELECT(DELYR>79:1,DELYR<-20:-1,1:0)_ENFY_ENMN_"01"
+3 SET ENTO=$$EOM^ENUTL(ENFR)
+4 QUIT
+5 ;
QT DO FYQTS^ENLIB
if '$DATA(ENQT)
GOTO ABORT
+1 NEW DELYR
SET DELYR=$EXTRACT(DT,2,3)-ENFY
SET ENFY(3)=$EXTRACT(DT)+$SELECT(DELYR>79:1,DELYR<-20:-1,1:0)_ENFY
+2 IF ENQT=1
SET ENFR=(ENFY(3)-1)_1001
SET ENTO=(ENFY(3)-1)_1231
QUIT
+3 IF ENQT=2
SET ENFR=ENFY(3)_"0101"
SET ENTO=ENFY(3)_"0331"
QUIT
+4 IF ENQT=3
SET ENFR=ENFY(3)_"0401"
SET ENTO=ENFY(3)_"0630"
QUIT
+5 SET ENFR=ENFY(3)_"0701"
SET ENTO=ENFY(3)_"0930"
+6 QUIT
+7 ;
YR DO FYSONLY^ENLIB
if '$DATA(ENFY)
GOTO ABORT
+1 NEW DELYR
SET DELYR=$EXTRACT(DT,2,3)-ENFY
SET ENFY(3)=$EXTRACT(DT)+$SELECT(DELYR>79:1,DELYR<-20:-1,1:0)_ENFY
+2 SET ENFR=(ENFY(3)-1)_1001
SET ENTO=ENFY(3)_"0930"
+3 QUIT
+4 ;
AR SET ENFR=0
QUIT
+1 ;
ABORT SET F=1
WRITE !!,"USER ABORT",*7,!,"<cr> to continue "
READ R:DTIME
QUIT
+1 ;
OPT ;;ACCIDENT REPORTING MODULE;ACCIDENT REPORT INTERVAL;ENFSA1;
+1 ;;MONTHLY;MN
+2 ;;QUARTERLY;QT
+3 ;;YEARLY;YR
+4 ;;ALL REPORTS;AR
