source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAUAW.m@ 1604

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1LRAUAW ;AVAMC/REG - AUTOPSY DATA ENTRY ;8/11/97
2 ;;5.2;LAB SERVICE;**72,115,121**;Sep 27, 1994
3 S:'$D(LRMD) LRMD=""
4 W !!,"Enter Weights & Measurements " S %=2 D YN^LRU I %<0 D END^LRAPLG1 Q
5 S DA=LRDFN,DIE="^LR(",LRSD=LREXP
6 S DR="11;S LRRC=X;14///"_LRAC_";14.1;S LRLLOC=X;14.5;14.6;S LRSVC=X;12.1;S LRMD=X;13.5:13.8",DR(2,63.19)=".01"
7 I %=1 D SET
8DIE W ! D ^DIE I $D(Y) W $C(7),!!,"All Prompts were not answered <ENTRY DELETED>" K ^LR(LRDFN,"AU"),^("AX") D X^LRAPLG1 Q
9 I $D(@(LRPF_DFN_",0)")),$P(^(0),"^",3) S X2=$P(^(0),"^",3),X1=LRSD D ^%DTC S AGE=$S(X>365.24:X\365.25,X>7:X\7_"w",X>0:X_"d",1:""),DR="12.5///"_AGE D ^DIE
10 S (LRCS,LRC(5))="",LRI=9999999-$P(LRSD,".")
11 D ^LRUWLF D:LRCAPA ^LRAPSWK D OERR^LR7OB63D Q
12DEL ;from LRUDEL
13 W !,"DATE DIED ",Y I $D(^LR(LRDFN,"AU")),$P(^("AU"),"^",3) W $C(7)," Cannot delete a completed autopsy." Q
14 L +^LR(LRDFN,"AU"):1 I '$T W !!?10,"Someone else is editing this entry ",!,$C(7) L -^LR(LRDFN,"AU") Q
15 W " OK to DELETE " S %=2 D YN^LRU Q:%'=1
16 D ACC^LR7OB1(LRAA,LRAD,LRAN,"OC") ;Cancel order
17 K ^LR(LRDFN,"AU"),^("AV"),^("AW"),^("AY"),^(33),^(80),^(81),^(82) F A=0:0 S A=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,A)) Q:'A K ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_A)
18 K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN),^LRO(68,LRAA,1,LRAD,1,"E",+LRRC,LRAN) D X^LRAPLG1 Q
19SET S DR=DR_";16:24;26:31;25;31.1:31.4;25.1:25.9" Q
20D ;get date died- called by DD(63,11,0),LRAPED,LRAPBK,LRAPS2,LRAPT2,LRAPAUSR,LRAPPF1,LRAPAUL,LRAPLG2
21 S A=^LR(DA,0),B=+$P(A,U,2),C=+$P(A,U,3),A=^DIC(B,0,"GL"),LR(63,12)=$S($D(@(A_C_",.35)")):+^(.35),1:""),LR(63,.02)=$P(^DIC(B,0),U) Q
Note: See TracBrowser for help on using the repository browser.