- LRAUAW ;AVAMC/REG/CKA - AUTOPSY DATA ENTRY ; 7/9/16 10:56pm
- ;;5.2;LAB SERVICE;**72,115,121,309,473**;Sep 27, 1994;Build 1
- ;Reference to DIC supported by IA #916
- S:'$D(LRMD) LRMD=""
- W !!,"Enter Weights & Measurements "
- S %=2
- D YN^LRU
- I %<0 D END^LRAPLG1 Q
- S DA=LRDFN,DIE="^LR(",LRSD=LREXP
- 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"
- I %=1 D SET
- DIE W !
- D ^DIE
- I $D(Y) W $C(7),!!,"All Prompts were not answered <ENTRY DELETED>" K ^LR(LRDFN,"AU"),^("AX") D X^LRAPLG1,END^LRAPLG1 Q
- 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
- S (LRCS,LRC(5))="",LRI=9999999-$P(LRSD,".")
- D ^LRUWLF
- D:LRCAPA ^LRAPSWK
- D OERR^LR7OB63D
- Q
- DEL ;from LRUDEL
- W !,"DATE DIED ",Y
- I $D(^LR(LRDFN,"AU")),$P(^("AU"),"^",3) W $C(7)," Cannot delete a completed autopsy." Q
- L +^LR(LRDFN,"AU"):1
- I '$T W !!?10,"Someone else is editing this entry ",!,$C(7) L -^LR(LRDFN,"AU") Q
- W " OK to DELETE "
- S %=2
- D YN^LRU
- Q:%'=1
- D ACC^LR7OB1(LRAA,LRAD,LRAN,"OC") ;Cancel order
- 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)
- K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
- K ^LRO(68,LRAA,1,LRAD,1,"E",+LRRC,LRAN)
- D X^LRAPLG1
- Q
- SET S DR=DR_";16:24;26:31;25;31.1:31.4;25.1:25.9"
- Q
- D ;get date died- called by DD(63,11,0),LRAPED,LRAPBK,LRAPS2,LRAPT2,
- ; LRAPAUSR,LRAPPF1,LRAPAUL,LRAPLG2
- S A=^LR(DA,0),B=+$P(A,U,2),C=+$P(A,U,3),A=^DIC(B,0,"GL")
- S LR(63,12)=$S($D(@(A_C_",.35)")):+^(.35),1:"")
- S LR(63,.02)=$P(^DIC(B,0),U)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAUAW 1754 printed Jan 18, 2025@03:10:23 Page 2
- 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
- +2 ;Reference to DIC supported by IA #916
- +3 if '$DATA(LRMD)
- SET LRMD=""
- +4 WRITE !!,"Enter Weights & Measurements "
- +5 SET %=2
- +6 DO YN^LRU
- +7 IF %<0
- DO END^LRAPLG1
- QUIT
- +8 SET DA=LRDFN
- SET DIE="^LR("
- SET LRSD=LREXP
- +9 SET 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"
- +10 IF %=1
- DO SET
- DIE WRITE !
- +1 DO ^DIE
- +2 IF $DATA(Y)
- WRITE $CHAR(7),!!,"All Prompts were not answered <ENTRY DELETED>"
- KILL ^LR(LRDFN,"AU"),^("AX")
- DO X^LRAPLG1
- DO END^LRAPLG1
- QUIT
- +3 IF $DATA(@(LRPF_DFN_",0)"))
- IF $PIECE(^(0),"^",3)
- SET X2=$PIECE(^(0),"^",3)
- SET X1=LRSD
- DO ^%DTC
- SET AGE=$SELECT(X>365.24:X\365.25,X>7:X\7_"w",X>0:X_"d",1:"")
- SET DR="12.5///"_AGE
- DO ^DIE
- +4 SET (LRCS,LRC(5))=""
- SET LRI=9999999-$PIECE(LRSD,".")
- +5 DO ^LRUWLF
- +6 if LRCAPA
- DO ^LRAPSWK
- +7 DO OERR^LR7OB63D
- +8 QUIT
- DEL ;from LRUDEL
- +1 WRITE !,"DATE DIED ",Y
- +2 IF $DATA(^LR(LRDFN,"AU"))
- IF $PIECE(^("AU"),"^",3)
- WRITE $CHAR(7)," Cannot delete a completed autopsy."
- QUIT
- +3 LOCK +^LR(LRDFN,"AU"):1
- +4 IF '$TEST
- WRITE !!?10,"Someone else is editing this entry ",!,$CHAR(7)
- LOCK -^LR(LRDFN,"AU")
- QUIT
- +5 WRITE " OK to DELETE "
- +6 SET %=2
- +7 DO YN^LRU
- +8 if %'=1
- QUIT
- +9 ;Cancel order
- DO ACC^LR7OB1(LRAA,LRAD,LRAN,"OC")
- +10 KILL ^LR(LRDFN,"AU"),^("AV"),^("AW"),^("AY"),^(33),^(80),^(81),^(82)
- +11 FOR A=0:0
- SET A=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,A))
- if 'A
- QUIT
- KILL ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_A)
- +12 KILL ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
- +13 KILL ^LRO(68,LRAA,1,LRAD,1,"E",+LRRC,LRAN)
- +14 DO X^LRAPLG1
- +15 QUIT
- SET SET DR=DR_";16:24;26:31;25;31.1:31.4;25.1:25.9"
- +1 QUIT
- D ;get date died- called by DD(63,11,0),LRAPED,LRAPBK,LRAPS2,LRAPT2,
- +1 ; LRAPAUSR,LRAPPF1,LRAPAUL,LRAPLG2
- +2 SET A=^LR(DA,0)
- SET B=+$PIECE(A,U,2)
- SET C=+$PIECE(A,U,3)
- SET A=^DIC(B,0,"GL")
- +3 SET LR(63,12)=$SELECT($DATA(@(A_C_",.35)")):+^(.35),1:"")
- +4 SET LR(63,.02)=$PIECE(^DIC(B,0),U)
- +5 QUIT