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

LRAUAW.m

Go to the documentation of this file.
  1. LRAUAW ;AVAMC/REG/CKA - AUTOPSY DATA ENTRY ; 7/9/16 10:56pm
  1. ;;5.2;LAB SERVICE;**72,115,121,309,473**;Sep 27, 1994;Build 1
  1. ;Reference to DIC supported by IA #916
  1. S:'$D(LRMD) LRMD=""
  1. W !!,"Enter Weights & Measurements "
  1. S %=2
  1. D YN^LRU
  1. I %<0 D END^LRAPLG1 Q
  1. S DA=LRDFN,DIE="^LR(",LRSD=LREXP
  1. 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"
  1. I %=1 D SET
  1. DIE W !
  1. D ^DIE
  1. I $D(Y) W $C(7),!!,"All Prompts were not answered <ENTRY DELETED>" K ^LR(LRDFN,"AU"),^("AX") D X^LRAPLG1,END^LRAPLG1 Q
  1. 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
  1. S (LRCS,LRC(5))="",LRI=9999999-$P(LRSD,".")
  1. D ^LRUWLF
  1. D:LRCAPA ^LRAPSWK
  1. D OERR^LR7OB63D
  1. Q
  1. DEL ;from LRUDEL
  1. W !,"DATE DIED ",Y
  1. I $D(^LR(LRDFN,"AU")),$P(^("AU"),"^",3) W $C(7)," Cannot delete a completed autopsy." Q
  1. L +^LR(LRDFN,"AU"):1
  1. I '$T W !!?10,"Someone else is editing this entry ",!,$C(7) L -^LR(LRDFN,"AU") Q
  1. W " OK to DELETE "
  1. S %=2
  1. D YN^LRU
  1. Q:%'=1
  1. D ACC^LR7OB1(LRAA,LRAD,LRAN,"OC") ;Cancel order
  1. K ^LR(LRDFN,"AU"),^("AV"),^("AW"),^("AY"),^(33),^(80),^(81),^(82)
  1. 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)
  1. K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
  1. K ^LRO(68,LRAA,1,LRAD,1,"E",+LRRC,LRAN)
  1. D X^LRAPLG1
  1. Q
  1. SET S DR=DR_";16:24;26:31;25;31.1:31.4;25.1:25.9"
  1. Q
  1. D ;get date died- called by DD(63,11,0),LRAPED,LRAPBK,LRAPS2,LRAPT2,
  1. ; LRAPAUSR,LRAPPF1,LRAPAUL,LRAPLG2
  1. S A=^LR(DA,0),B=+$P(A,U,2),C=+$P(A,U,3),A=^DIC(B,0,"GL")
  1. S LR(63,12)=$S($D(@(A_C_",.35)")):+^(.35),1:"")
  1. S LR(63,.02)=$P(^DIC(B,0),U)
  1. Q