LRAUAW.m

LRAUAW ;AVAMC/REG/CKA - AUTOPSY DATA ENTRY ;8/11/97

 ;;5.2;LAB SERVICE;**1002,1003,1013,1031**;NOV 1, 1997

 ;

 ;;VA LR Patche(s): 72,115,121,309

 ;

 ;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 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

LRAUAW    ;AVAMC/REG/CKA - AUTOPSY DATA ENTRY ;8/11/97

 +1       ;;5.2;LAB SERVICE;**1002,1003,1013,1031**;NOV 1, 1997

 +2       ;

 +3       ;;VA LR Patche(s): 72,115,121,309

 +4       ;

 +5       ;Reference to DIC supported by IA #916

 +6        IF '$DATA(LRMD)

               SET LRMD=""

 +7        WRITE !!,"Enter Weights & Measurements "

 +8        SET %=2

 +9        DO YN^LRU

 +10       IF %<0

               DO END^LRAPLG1

               QUIT 

 +11       SET DA=LRDFN

           SET DIE="^LR("

           SET LRSD=LREXP

 +12       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"

 +13       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

               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