- 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 Jan 18, 2025@02:55:09 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