source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFSA.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1ENFSA ;(WASH ISC)/JED/DH-Enter or Edit Accident Report (2162) ;2.18.98
2V ;;7.0;ENGINEERING;**48**;Aug 17, 1993
3 ;EXPECTS IOF,U; CALLS %DT,%ZIS,YN^DICN,DT^DICRW,^DIC,EN^ENJ,DEV^ENLIB
4 ;
5 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
6 K ^DOPT($P(O,S,5))
7 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)=""
8 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)
9IN I $P(O,S,6)'="" D @($P(O,S,6))
10PR S O=$T(OPT),S=";" S IOP="HOME" D ^%ZIS W:IOST'["PK-" @IOF K IOP
11 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)
12RE 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
13 ;
14HDR W @IOF,!!,?12,"ENGINEERING ACCIDENT REPORTING MODULE",! Q
15 ;
16R1 ;ENTER NEW ACCIDENT REPORT
17 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
18 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
19 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
20 S ENR=ENY_"0001" I '$D(^ENG("FSA","B",ENR)) G SET
21 S ENR=$O(^ENG("FSA","B",ENY_"9999"),-1)+1
22SET S ENFNO=$P(^ENG("FSA",0),U,1,2),ENNXL=$P(^ENG("FSA",0),U,3),ENNXT=$P(^ENG("FSA",0),U,4)
23SET1 S ENNXL=ENNXL+1 I $D(^ENG("FSA",ENNXL,0))>0 G SET1
24 S ENNXT=ENNXT+1 S ENOUT=ENFNO_U_ENNXL_U_ENNXT
25 S ^ENG("FSA",ENNXL,0)=ENR,^ENG("FSA","B",ENR,ENNXL)="",^ENG("FSA",0)=ENOUT
26 L +^ENG("FSA",ENNXL)
27 S DJSC="ENFSA1",(DJDN,ENLOCK)=ENNXL K ENFNO,ENNXL,ENNXT,ENOUT,ENR,ENY,I,J,K
28 L -^ENG("FSA",0),-^ENG("FSA","B") D EN^ENJ L -^ENG("FSA",ENLOCK) G EXIT
29R2 ;EDIT 2162 REPORT
30 D:'($D(ENLO)&$D(ENHI)) INIT^EN S DIC="^ENG(""FSA"",",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT
31 S (DJDN,ENLOCK)=+Y,DJSC="ENFSA1"
32 L +^ENG("FSA",DJDN):3 I '$T W *7,!,"Record being edited by someone else. Please try later." D HLD G EXIT
33 D EN^ENJ L -^ENG("FSA",ENLOCK) G EXIT
34R3 ;DISPLAY 2162 REPORT
35 D:'($D(ENLO)&$D(ENHI)) INIT^EN S DIC="^ENG(""FSA"",",DIC(0)="AEQM" D ^DIC G:Y<0 EXIT
36 S DJDN=+Y,DJDIS=1,DJSC="ENFSA1" D EN^ENJ G EXIT
37R4 ;PRINT 2162 ACCIDENT REPORT
38 Q
39MSG W !!,"one moment please" Q
40 ;
41HLD W !!,"Press <RETURN> to continue..." R X:DTIME
42 Q
43 ;
44EXIT 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
45 K DJDN,DJSC,DJDIS,ENLOCK
46 Q
47 ;
48INIT S:$D(DTIME)<1 DTIME=600 D DT^DICRW S IOP="HOME",U="^" D ^%ZIS K IOP
49 Q
50 ;
51OPT ;;ACCIDENT REPORTING MODULE; ACCIDENT REPORTING OPTIONS;ENFSA;INIT
52 ;;ENTER 2162 REPORT;R1
53 ;;EDIT 2162 REPORT;R2
54 ;;DISPLAY 2162 REPORT;R3
55 ;;SUMMARY REPORT BY SERVICE/DIVISION;P10^ENFSA1
56 ;;SUMMARY REPORT BY INJURY CAUSE;P20^ENFSA1
57 ;;SUMMARY REPORT BY ACCIDENT NATURE;P30^ENFSA1
58 ;;SUMMARY REPORT BY SPECIFIC LOCATION;P40^ENFSA1
Note: See TracBrowser for help on using the repository browser.