ENFSA ;(WASH ISC)/JED/DH-Enter or Edit Accident Report (2162) ;2.18.98
V ;;7.0;ENGINEERING;**48**;Aug 17, 1993
;EXPECTS IOF,U; CALLS %DT,%ZIS,YN^DICN,DT^DICRW,^DIC,EN^ENJ,DEV^ENLIB
;
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 W:IOST'["PK-" @IOF 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 W ! 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) EXIT G:Y<0 RE K DIC,J,O D @($P($T(OPT+Y),S,4)) G PR
;
HDR W @IOF,!!,?12,"ENGINEERING ACCIDENT REPORTING MODULE",! Q
;
R1 ;ENTER NEW ACCIDENT REPORT
D:'($D(ENLO)&$D(ENHI)) INIT^EN D MSG,DT^DICRW S ENY=$E(DT,1,3)+1700 S:$E(DT,4,7)>1000 ENY=ENY+1
L +^ENG("FSA",0):5 I '$T W !!,*7,"Can't add new records at this time. Please try again later." D HLD G EXIT
L +^ENG("FSA","B"):20 I '$T L -^ENG("FSA",0) W !!,*7,"Someone else is adding a record. Please try again later." D HLD G EXIT
S ENR=ENY_"0001" I '$D(^ENG("FSA","B",ENR)) G SET
S ENR=$O(^ENG("FSA","B",ENY_"9999"),-1)+1
SET S ENFNO=$P(^ENG("FSA",0),U,1,2),ENNXL=$P(^ENG("FSA",0),U,3),ENNXT=$P(^ENG("FSA",0),U,4)
SET1 S ENNXL=ENNXL+1 I $D(^ENG("FSA",ENNXL,0))>0 G SET1
S ENNXT=ENNXT+1 S ENOUT=ENFNO_U_ENNXL_U_ENNXT
S ^ENG("FSA",ENNXL,0)=ENR,^ENG("FSA","B",ENR,ENNXL)="",^ENG("FSA",0)=ENOUT
L +^ENG("FSA",ENNXL)
S DJSC="ENFSA1",(DJDN,ENLOCK)=ENNXL K ENFNO,ENNXL,ENNXT,ENOUT,ENR,ENY,I,J,K
L -^ENG("FSA",0),-^ENG("FSA","B") D EN^ENJ L -^ENG("FSA",ENLOCK) G EXIT
R2 ;EDIT 2162 REPORT
D:'($D(ENLO)&$D(ENHI)) INIT^EN S DIC="^ENG(""FSA"",",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT
S (DJDN,ENLOCK)=+Y,DJSC="ENFSA1"
L +^ENG("FSA",DJDN):3 I '$T W *7,!,"Record being edited by someone else. Please try later." D HLD G EXIT
D EN^ENJ L -^ENG("FSA",ENLOCK) G EXIT
R3 ;DISPLAY 2162 REPORT
D:'($D(ENLO)&$D(ENHI)) INIT^EN S DIC="^ENG(""FSA"",",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT
S DJDN=+Y,DJDIS=1,DJSC="ENFSA1" D EN^ENJ G EXIT
R4 ;PRINT 2162 ACCIDENT REPORT
Q
MSG W !!,"one moment please" Q
;
HLD W !!,"Press <RETURN> to continue..." R X:DTIME
Q
;
EXIT W @IOF,@ENLO K %,DA,DIC,DIE,ENL,I,J,K,O,R,S,Y,Z,IO("Q"),DJD0,DJLG,DJSW2,DJLS,DR,DN,XY
K DJDN,DJSC,DJDIS,ENLOCK
Q
;
INIT S:$D(DTIME)<1 DTIME=600 D DT^DICRW S IOP="HOME",U="^" D ^%ZIS K IOP
Q
;
OPT ;;ACCIDENT REPORTING MODULE; ACCIDENT REPORTING OPTIONS;ENFSA;INIT
;;ENTER 2162 REPORT;R1
;;EDIT 2162 REPORT;R2
;;DISPLAY 2162 REPORT;R3
;;SUMMARY REPORT BY SERVICE/DIVISION;P10^ENFSA1
;;SUMMARY REPORT BY INJURY CAUSE;P20^ENFSA1
;;SUMMARY REPORT BY ACCIDENT NATURE;P30^ENFSA1
;;SUMMARY REPORT BY SPECIFIC LOCATION;P40^ENFSA1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFSA 3062 printed Apr 09, 2024@20:57:31 Page 2
ENFSA ;(WASH ISC)/JED/DH-Enter or Edit Accident Report (2162) ;2.18.98
V ;;7.0;ENGINEERING;**48**;Aug 17, 1993
+1 ;EXPECTS IOF,U; CALLS %DT,%ZIS,YN^DICN,DT^DICRW,^DIC,EN^ENJ,DEV^ENLIB
+2 ;
+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
if IOST'["PK-"
WRITE @IOF
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 WRITE !
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 EXIT
if Y<0
GOTO RE
KILL DIC,J,O
DO @($PIECE($TEXT(OPT+Y),S,4))
GOTO PR
+1 ;
HDR WRITE @IOF,!!,?12,"ENGINEERING ACCIDENT REPORTING MODULE",!
QUIT
+1 ;
R1 ;ENTER NEW ACCIDENT REPORT
+1 if '($DATA(ENLO)&$DATA(ENHI))
DO INIT^EN
DO MSG
DO DT^DICRW
SET ENY=$EXTRACT(DT,1,3)+1700
if $EXTRACT(DT,4,7)>1000
SET ENY=ENY+1
+2 LOCK +^ENG("FSA",0):5
IF '$TEST
WRITE !!,*7,"Can't add new records at this time. Please try again later."
DO HLD
GOTO EXIT
+3 LOCK +^ENG("FSA","B"):20
IF '$TEST
LOCK -^ENG("FSA",0)
WRITE !!,*7,"Someone else is adding a record. Please try again later."
DO HLD
GOTO EXIT
+4 SET ENR=ENY_"0001"
IF '$DATA(^ENG("FSA","B",ENR))
GOTO SET
+5 SET ENR=$ORDER(^ENG("FSA","B",ENY_"9999"),-1)+1
SET SET ENFNO=$PIECE(^ENG("FSA",0),U,1,2)
SET ENNXL=$PIECE(^ENG("FSA",0),U,3)
SET ENNXT=$PIECE(^ENG("FSA",0),U,4)
SET1 SET ENNXL=ENNXL+1
IF $DATA(^ENG("FSA",ENNXL,0))>0
GOTO SET1
+1 SET ENNXT=ENNXT+1
SET ENOUT=ENFNO_U_ENNXL_U_ENNXT
+2 SET ^ENG("FSA",ENNXL,0)=ENR
SET ^ENG("FSA","B",ENR,ENNXL)=""
SET ^ENG("FSA",0)=ENOUT
+3 LOCK +^ENG("FSA",ENNXL)
+4 SET DJSC="ENFSA1"
SET (DJDN,ENLOCK)=ENNXL
KILL ENFNO,ENNXL,ENNXT,ENOUT,ENR,ENY,I,J,K
+5 LOCK -^ENG("FSA",0),-^ENG("FSA","B")
DO EN^ENJ
LOCK -^ENG("FSA",ENLOCK)
GOTO EXIT
R2 ;EDIT 2162 REPORT
+1 if '($DATA(ENLO)&$DATA(ENHI))
DO INIT^EN
SET DIC="^ENG(""FSA"","
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
GOTO EXIT
+2 SET (DJDN,ENLOCK)=+Y
SET DJSC="ENFSA1"
+3 LOCK +^ENG("FSA",DJDN):3
IF '$TEST
WRITE *7,!,"Record being edited by someone else. Please try later."
DO HLD
GOTO EXIT
+4 DO EN^ENJ
LOCK -^ENG("FSA",ENLOCK)
GOTO EXIT
R3 ;DISPLAY 2162 REPORT
+1 if '($DATA(ENLO)&$DATA(ENHI))
DO INIT^EN
SET DIC="^ENG(""FSA"","
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
GOTO EXIT
+2 SET DJDN=+Y
SET DJDIS=1
SET DJSC="ENFSA1"
DO EN^ENJ
GOTO EXIT
R4 ;PRINT 2162 ACCIDENT REPORT
+1 QUIT
MSG WRITE !!,"one moment please"
QUIT
+1 ;
HLD WRITE !!,"Press <RETURN> to continue..."
READ X:DTIME
+1 QUIT
+2 ;
EXIT WRITE @IOF,@ENLO
KILL %,DA,DIC,DIE,ENL,I,J,K,O,R,S,Y,Z,IO("Q"),DJD0,DJLG,DJSW2,DJLS,DR,DN,XY
+1 KILL DJDN,DJSC,DJDIS,ENLOCK
+2 QUIT
+3 ;
INIT if $DATA(DTIME)<1
SET DTIME=600
DO DT^DICRW
SET IOP="HOME"
SET U="^"
DO ^%ZIS
KILL IOP
+1 QUIT
+2 ;
OPT ;;ACCIDENT REPORTING MODULE; ACCIDENT REPORTING OPTIONS;ENFSA;INIT
+1 ;;ENTER 2162 REPORT;R1
+2 ;;EDIT 2162 REPORT;R2
+3 ;;DISPLAY 2162 REPORT;R3
+4 ;;SUMMARY REPORT BY SERVICE/DIVISION;P10^ENFSA1
+5 ;;SUMMARY REPORT BY INJURY CAUSE;P20^ENFSA1
+6 ;;SUMMARY REPORT BY ACCIDENT NATURE;P30^ENFSA1
+7 ;;SUMMARY REPORT BY SPECIFIC LOCATION;P40^ENFSA1
