Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENFSA

ENFSA.m

Go to the documentation of this file.
  1. ENFSA ;(WASH ISC)/JED/DH-Enter or Edit Accident Report (2162) ;2.18.98
  1. V ;;7.0;ENGINEERING;**48**;Aug 17, 1993
  1. ;EXPECTS IOF,U; CALLS %DT,%ZIS,YN^DICN,DT^DICRW,^DIC,EN^ENJ,DEV^ENLIB
  1. ;
  1. 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
  1. K ^DOPT($P(O,S,5))
  1. 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)=""
  1. 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)
  1. IN I $P(O,S,6)'="" D @($P(O,S,6))
  1. PR S O=$T(OPT),S=";" S IOP="HOME" D ^%ZIS W:IOST'["PK-" @IOF K IOP
  1. 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)
  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
  1. ;
  1. HDR W @IOF,!!,?12,"ENGINEERING ACCIDENT REPORTING MODULE",! Q
  1. ;
  1. R1 ;ENTER NEW ACCIDENT REPORT
  1. 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
  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
  1. 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
  1. S ENR=ENY_"0001" I '$D(^ENG("FSA","B",ENR)) G SET
  1. S ENR=$O(^ENG("FSA","B",ENY_"9999"),-1)+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)
  1. SET1 S ENNXL=ENNXL+1 I $D(^ENG("FSA",ENNXL,0))>0 G SET1
  1. S ENNXT=ENNXT+1 S ENOUT=ENFNO_U_ENNXL_U_ENNXT
  1. S ^ENG("FSA",ENNXL,0)=ENR,^ENG("FSA","B",ENR,ENNXL)="",^ENG("FSA",0)=ENOUT
  1. L +^ENG("FSA",ENNXL)
  1. S DJSC="ENFSA1",(DJDN,ENLOCK)=ENNXL K ENFNO,ENNXL,ENNXT,ENOUT,ENR,ENY,I,J,K
  1. L -^ENG("FSA",0),-^ENG("FSA","B") D EN^ENJ L -^ENG("FSA",ENLOCK) G EXIT
  1. R2 ;EDIT 2162 REPORT
  1. D:'($D(ENLO)&$D(ENHI)) INIT^EN S DIC="^ENG(""FSA"",",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT
  1. S (DJDN,ENLOCK)=+Y,DJSC="ENFSA1"
  1. L +^ENG("FSA",DJDN):3 I '$T W *7,!,"Record being edited by someone else. Please try later." D HLD G EXIT
  1. D EN^ENJ L -^ENG("FSA",ENLOCK) G EXIT
  1. R3 ;DISPLAY 2162 REPORT
  1. D:'($D(ENLO)&$D(ENHI)) INIT^EN S DIC="^ENG(""FSA"",",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT
  1. S DJDN=+Y,DJDIS=1,DJSC="ENFSA1" D EN^ENJ G EXIT
  1. R4 ;PRINT 2162 ACCIDENT REPORT
  1. Q
  1. MSG W !!,"one moment please" Q
  1. ;
  1. HLD W !!,"Press <RETURN> to continue..." R X:DTIME
  1. Q
  1. ;
  1. 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
  1. K DJDN,DJSC,DJDIS,ENLOCK
  1. Q
  1. ;
  1. INIT S:$D(DTIME)<1 DTIME=600 D DT^DICRW S IOP="HOME",U="^" D ^%ZIS K IOP
  1. Q
  1. ;
  1. OPT ;;ACCIDENT REPORTING MODULE; ACCIDENT REPORTING OPTIONS;ENFSA;INIT
  1. ;;ENTER 2162 REPORT;R1
  1. ;;EDIT 2162 REPORT;R2
  1. ;;DISPLAY 2162 REPORT;R3
  1. ;;SUMMARY REPORT BY SERVICE/DIVISION;P10^ENFSA1
  1. ;;SUMMARY REPORT BY INJURY CAUSE;P20^ENFSA1
  1. ;;SUMMARY REPORT BY ACCIDENT NATURE;P30^ENFSA1
  1. ;;SUMMARY REPORT BY SPECIFIC LOCATION;P40^ENFSA1