- ENFSA1 ;(WASH ISC)/JED-Accident Reports ;5-29-93
- ;;7.0;ENGINEERING;;Aug 17, 1993
- ;EXPECTS IOF,U, CALLS ^%ZIS,^DIC,EN1^DIP,ENFSA2,ENLIB CALLED BY ENFSA
- P10 ;Report by SERVICE/DIVISION
- S ENH=" SERVICE",ENHD=" SERVICE/DIVISION" D INT^ENFSA2 G:F=1 EXIT X ENQ G:%=1&(ENFR=0) P11
- S BY="SERVICE/DIVISION #,OCCURRENCE DATE" G:%=1 PS3
- S DIC="^ENG(6924.3,",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT S X=$P(^ENG(6924.3,+Y,0),U,1),(ENFR1,ENTO1)=X G:ENFR=0 PS2 G PS1
- P11 S BY=25,FR="",TO="",DHD="ALL "_ENAR_"S BY"_ENHD G PS4
- ;
- P20 ;Report by INJURY CAUSE
- S ENH=" CAUSE",ENHD=" CAUSE OF INJURY" D INT^ENFSA2 G:F=1 EXIT X ENQ G:%=1&(ENFR=0) P22
- S BY="CAUSE OF INJURY,OCCURRENCE DATE" G:%=1 PS3
- I $D(^DD(6924,32,0)) S ENHDR=$P(^(0),U,1),ENMEN=$P(^(0),U,3)
- W !!?10,ENHDR,!! F I=1:1:12 W ?10,I,?14,$P(ENMEN,";",I),!
- P21 W !!?5,"Select CAUSE NUMBER: " R X:DTIME G:X=""!(X="^") EXIT G:X<1!(X>12) P21
- S X=$P($P(ENMEN,";",X),":",2),(ENFR1,ENTO1)=X G:ENFR=0 PS2 G PS1
- P22 S BY=32,FR="",TO="",DHD=ENAR_" BY"_ENHD G PS4
- ;
- P30 ;Report by ACCIDENT NATURE
- S ENH=" NATURE",ENHD=" INJURY/ILLNESS NATURE" D INT^ENFSA2 G:F=1 EXIT X ENQ G:%=1&(ENFR=0) P31
- S BY=30_","_5 G:%=1 PS3
- S DIC="^ENG(6924.2,",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT S X=^ENG(6924.2,+Y,0),(ENFR1,ENTO1)=X G:ENFR=0 PS2 G PS1
- P31 S BY=30,FR="",TO="",DHD="ALL "_ENAR_"S BY"_ENHD G PS4
- ;
- P40 ;Report by LOCATION
- S ENH=" LOCATION",ENHD=" SPECIFIC LOCATION" D INT^ENFSA2 G:F=1 EXIT X ENQ G:%<0 EXIT G:%=0 P40 G:%=1&(ENFR=0) P42
- S BY="SPECIFIC LOCATION,OCCURRENCE DATE" G:%=1 PS3
- P41 W !!?10,"Enter",ENHD,": " R X:DTIME S:X["??" X="?" I X=""!(X="^") G EXIT
- I $E(X)="?"!($L(X)>25) W *7,!!?5,"UP TO 25 CHARACTERS PLEASE" G P41
- S (ENFR1,ENTO1)=X G:ENFR=0 PS2 G PS1
- P42 S BY=7.5,FR="",TO="",DHD=ENAR_" BY"_ENHD G PS4
- ;SET UP COMMON PRINT VARIABLES FOR FM
- PS1 D DAT S FR=ENFR1_","_ENFR,TO=ENTO1_","_ENTO,DHD=ENAR_" SUMMARY: "_ENFR1_ENH_" FROM: "_ENFH_" TO: "_ENTH G PS4
- PS2 S FR=ENFR1_","_"",TO=ENTO1_","_"",DHD=ENAR_" SUMMARY: "_ENFR1_ENH G PS4
- PS3 D DAT S FR=""_","_ENFR,TO=""_","_ENTO,DHD=ENAR_" SUMMARY BY: "_ENH_" FROM: "_ENFH_" TO: "_ENTH
- PS4 I $D(^ENG(6910.2,3,0)),$P(^(0),U,2)="L",$D(^DIPT("B","ENZFSA1")) S FLDS="[ENZFSA1]"
- E S FLDS="[ENFSA1]"
- S DIC="^ENG(""FSA"",",L=0,DIOEND="I IOST[""C-"" R !!,""Press <RETURN> to continue"",X:DTIME" D EN1^DIP G EXIT
- EXIT K %,%IS,BY,DHD,DIC,FLDS,FR,TO,F,I,J,K,L,R,X,Y
- K ENAR,ENDY,ENFH,ENFR,ENFR1,ENFY,ENH,ENHD,ENHDR,ENMEN,ENMN,ENQ,ENQT,ENTH,ENTO,ENTO1 Q
- DAT S Y=ENFR X ^DD("DD") S ENFH=Y,Y=ENTO X ^DD("DD") S ENTH=Y K Y Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFSA1 2549 printed Feb 18, 2025@23:20:21 Page 2
- ENFSA1 ;(WASH ISC)/JED-Accident Reports ;5-29-93
- +1 ;;7.0;ENGINEERING;;Aug 17, 1993
- +2 ;EXPECTS IOF,U, CALLS ^%ZIS,^DIC,EN1^DIP,ENFSA2,ENLIB CALLED BY ENFSA
- P10 ;Report by SERVICE/DIVISION
- +1 SET ENH=" SERVICE"
- SET ENHD=" SERVICE/DIVISION"
- DO INT^ENFSA2
- if F=1
- GOTO EXIT
- XECUTE ENQ
- if %=1&(ENFR=0)
- GOTO P11
- +2 SET BY="SERVICE/DIVISION #,OCCURRENCE DATE"
- if %=1
- GOTO PS3
- +3 SET DIC="^ENG(6924.3,"
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y<0
- GOTO EXIT
- SET X=$PIECE(^ENG(6924.3,+Y,0),U,1)
- SET (ENFR1,ENTO1)=X
- if ENFR=0
- GOTO PS2
- GOTO PS1
- P11 SET BY=25
- SET FR=""
- SET TO=""
- SET DHD="ALL "_ENAR_"S BY"_ENHD
- GOTO PS4
- +1 ;
- P20 ;Report by INJURY CAUSE
- +1 SET ENH=" CAUSE"
- SET ENHD=" CAUSE OF INJURY"
- DO INT^ENFSA2
- if F=1
- GOTO EXIT
- XECUTE ENQ
- if %=1&(ENFR=0)
- GOTO P22
- +2 SET BY="CAUSE OF INJURY,OCCURRENCE DATE"
- if %=1
- GOTO PS3
- +3 IF $DATA(^DD(6924,32,0))
- SET ENHDR=$PIECE(^(0),U,1)
- SET ENMEN=$PIECE(^(0),U,3)
- +4 WRITE !!?10,ENHDR,!!
- FOR I=1:1:12
- WRITE ?10,I,?14,$PIECE(ENMEN,";",I),!
- P21 WRITE !!?5,"Select CAUSE NUMBER: "
- READ X:DTIME
- if X=""!(X="^")
- GOTO EXIT
- if X<1!(X>12)
- GOTO P21
- +1 SET X=$PIECE($PIECE(ENMEN,";",X),":",2)
- SET (ENFR1,ENTO1)=X
- if ENFR=0
- GOTO PS2
- GOTO PS1
- P22 SET BY=32
- SET FR=""
- SET TO=""
- SET DHD=ENAR_" BY"_ENHD
- GOTO PS4
- +1 ;
- P30 ;Report by ACCIDENT NATURE
- +1 SET ENH=" NATURE"
- SET ENHD=" INJURY/ILLNESS NATURE"
- DO INT^ENFSA2
- if F=1
- GOTO EXIT
- XECUTE ENQ
- if %=1&(ENFR=0)
- GOTO P31
- +2 SET BY=30_","_5
- if %=1
- GOTO PS3
- +3 SET DIC="^ENG(6924.2,"
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y<0
- GOTO EXIT
- SET X=^ENG(6924.2,+Y,0)
- SET (ENFR1,ENTO1)=X
- if ENFR=0
- GOTO PS2
- GOTO PS1
- P31 SET BY=30
- SET FR=""
- SET TO=""
- SET DHD="ALL "_ENAR_"S BY"_ENHD
- GOTO PS4
- +1 ;
- P40 ;Report by LOCATION
- +1 SET ENH=" LOCATION"
- SET ENHD=" SPECIFIC LOCATION"
- DO INT^ENFSA2
- if F=1
- GOTO EXIT
- XECUTE ENQ
- if %<0
- GOTO EXIT
- if %=0
- GOTO P40
- if %=1&(ENFR=0)
- GOTO P42
- +2 SET BY="SPECIFIC LOCATION,OCCURRENCE DATE"
- if %=1
- GOTO PS3
- P41 WRITE !!?10,"Enter",ENHD,": "
- READ X:DTIME
- if X["??"
- SET X="?"
- IF X=""!(X="^")
- GOTO EXIT
- +1 IF $EXTRACT(X)="?"!($LENGTH(X)>25)
- WRITE *7,!!?5,"UP TO 25 CHARACTERS PLEASE"
- GOTO P41
- +2 SET (ENFR1,ENTO1)=X
- if ENFR=0
- GOTO PS2
- GOTO PS1
- P42 SET BY=7.5
- SET FR=""
- SET TO=""
- SET DHD=ENAR_" BY"_ENHD
- GOTO PS4
- +1 ;SET UP COMMON PRINT VARIABLES FOR FM
- PS1 DO DAT
- SET FR=ENFR1_","_ENFR
- SET TO=ENTO1_","_ENTO
- SET DHD=ENAR_" SUMMARY: "_ENFR1_ENH_" FROM: "_ENFH_" TO: "_ENTH
- GOTO PS4
- PS2 SET FR=ENFR1_","_""
- SET TO=ENTO1_","_""
- SET DHD=ENAR_" SUMMARY: "_ENFR1_ENH
- GOTO PS4
- PS3 DO DAT
- SET FR=""_","_ENFR
- SET TO=""_","_ENTO
- SET DHD=ENAR_" SUMMARY BY: "_ENH_" FROM: "_ENFH_" TO: "_ENTH
- PS4 IF $DATA(^ENG(6910.2,3,0))
- IF $PIECE(^(0),U,2)="L"
- IF $DATA(^DIPT("B","ENZFSA1"))
- SET FLDS="[ENZFSA1]"
- +1 IF '$TEST
- SET FLDS="[ENFSA1]"
- +2 SET DIC="^ENG(""FSA"","
- SET L=0
- SET DIOEND="I IOST[""C-"" R !!,""Press <RETURN> to continue"",X:DTIME"
- DO EN1^DIP
- GOTO EXIT
- EXIT KILL %,%IS,BY,DHD,DIC,FLDS,FR,TO,F,I,J,K,L,R,X,Y
- +1 KILL ENAR,ENDY,ENFH,ENFR,ENFR1,ENFY,ENH,ENHD,ENHDR,ENMEN,ENMN,ENQ,ENQT,ENTH,ENTO,ENTO1
- QUIT
- DAT SET Y=ENFR
- XECUTE ^DD("DD")
- SET ENFH=Y
- SET Y=ENTO
- XECUTE ^DD("DD")
- SET ENTH=Y
- KILL Y
- QUIT
- +1 ;
