LRAPDSR ;DALOI/STAFF - AP SUPPLEMENTARY REPORT ENTRY;Dec 17, 2008
;;5.2;LAB SERVICE;**248,259,295,317,350**;Sep 27, 1994;Build 230
;
N LRYTMP,LRWPROOT,LRRLS,LRRLS1,LRRLS2,LRX,LRIENS,LRFILE1,LRFILE,LRA
N LRIENS1,LRXTMP,LRFDA,LRNOW,LRIENS2,LRFIELD,LRORIEN,LRFLG,LRDA,LRQUIT,LRSRDA
;
MAIN ; Main Subroutine
D RELEAS1
D GETRPT
Q:LRQUIT
D RELEAS2
Q:LRQUIT
D:LRRLS COPY
Q:LRQUIT
D RPT
;
; Ask for performing laboratory assignment
D EDIT^LRRPLU(LRDFN,LRSS,LRI)
;
; Add supp report to the PRELIMINARY print queue
D QUESP
Q:LRQUIT
D COMPARE
Q:LRQUIT
;
; If supp report is already released (LRRLS1) unrelease it only if the E-Sign Switch is ON (LRESSW)
N LRESSW
D GETDATA^LRAPESON(.LRESSW)
I LRRLS1,LRESSW D UNRELEAS
D UPDATE
Q:LRQUIT
D STORE
Q
;
;
RELEAS1 ; Is the ENTIRE report already released?
S (LRRLS,LRRLS1,LRQUIT)=0
I LRSS="AU" D Q
. S LRX=$P($G(^LR(LRDFN,LRSS)),"^",15)
. Q:'LRX ; Report has not been released so no audit will occur.
. W !!,$C(7),"This AUTOPSY has been released. Supplementary report additions/modifications"
. W !,"will create an audit trail.",!
. S LRRLS=1 ; Report has been released so auditing will occur.
S LRX=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11)
;
I LRX D
. W $C(7),!!,"This "_$G(LRAA(1))_" report has been released."
. W !,"Supplementary report additions/modifications will create an audit trail.",!
. S LRRLS=1
Q
;
;
GETRPT ; First, select the report
;
N DA,DIC,DO,DIR,DIRUT,DTOUT,DUOUT,LRLAST,LRSFN,LRX,X,Y
;
S (X,Y)=0
I LRSS'="AU" D
. F S X=$O(^LR(LRDFN,LRSS,LRI,1.2,X)) Q:'X D
. . S X(0)=^LR(LRDFN,LRSS,LRI,1.2,X,0),Y=Y+1
. . S DIR("A",Y)=Y_" - "_$$FMTE^XLFDT($P(X(0),"^"),"1M")
. . S LRSFN=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
. . I $P(X(0),"^",2)'="" S DIR("A",Y)=DIR("A",Y)_" Released: "_$$EXTERNAL^DILFD(LRSFN,.02,"",$P(X(0),"^",2))
. . I $P(X(0),"^",3)'="" S DIR("A",Y)=DIR("A",Y)_" Report Modified: "_$$EXTERNAL^DILFD(LRSFN,.03,"",$P(X(0),"^",3))
. . S LRX(Y)=X
;
I LRSS="AU" D
. F S X=$O(^LR(LRDFN,84,X)) Q:'X D
. . S X(0)=^LR(LRDFN,84,X,0),Y=Y+1
. . S DIR("A",Y)=Y_" - "_$$FMTE^XLFDT($P(X(0),"^"),"1M")
. . I $P(X(0),"^",2)'="" S DIR("A",Y)=DIR("A",Y)_" Released: "_$$EXTERNAL^DILFD(63.324,.02,"",$P(X(0),"^",2))
. . I $P(X(0),"^",3)'="" S DIR("A",Y)=DIR("A",Y)_" Report Modified: "_$$EXTERNAL^DILFD(63.324,.03,"",$P(X(0),"^",3))
. . S LRX(Y)=X
;
S LRLAST=Y+1
I LRLAST>1 D Q:LRQUIT
. S DIR("A",LRLAST)=LRLAST_" - Add a new SUPPLEMENTARY REPORT"
. S DIR("A")="Select SUPPLEMENTARY REPORT"
. S DIR("?",1)="Enter a number from 1 to "_LRLAST
. S DIR("?")="Select the number of the supplementary report to edit"
. S DIR(0)="NO:1:"_LRLAST_":0"
. D ^DIR
. I Y<1 S LRQUIT=1 Q
;
; Selected existing report
I LRLAST>1,Y<LRLAST S LRSRDA=LRX(Y) Q
;
; Adding new report - ask for new date/time
K DIR,DIRUT,DTOUT,DUOUT,X,Y
I LRLAST=1 W !,"Adding a new SUPPLEMENTARY REPORT"
S DIR(0)=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="AU":63.324,LRSS="EM":63.207,1:"")_",.01"
D ^DIR
I Y<1 S LRQUIT=1 Q
;
K DA,DO,DIC
I LRSS'="AU" S DIC="^LR(LRDFN,LRSS,LRI,1.2,",DA(1)=LRDFN,DA=LRI
E S DIC="^LR(LRDFN,84,",DA=LRDFN
S DIC(0)="EF",X=+Y,DIC("DR")=".02////0"
D FILE^DICN
I Y<1 S LRQUIT=1
S LRSRDA=+Y
;
Q
;
;
RELEAS2 ; Is the supplementary report already released?
;
I LRSS'="AU" S LRX=$G(^LR(LRDFN,LRSS,LRI,1.2,LRSRDA,0))
E S LRX=$G(^LR(LRDFN,84,LRSRDA,0))
S LRRLS2=+$P(LRX,"^",2)
I LRRLS2 D
. N DIR,DIRUT,DTOUT,DUOUT,X,Y
. S DIR(0)="YO",DIR("B")="NO"
. S DIR("A",1)=$C(7)
. S DIR("A",2)="This supplementary report has been released."
. S DIR("A",3)="Additions/modifications will create an audit trail."
. S DIR("A")="Sure you want to update this record"
. D ^DIR
. I Y=1 S LRRLS1=1
. E S LRQUIT=1
Q
;
;
COPY ; Make a copy of the current report.
K ^TMP("DIQ1",$J)
S LRIENS=LRSRDA_","_$S(LRSS'="AU":LRI_",",1:"")_LRDFN_","
S LRFILE1=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
S:LRFILE1="" LRFILE1=$S(LRSS="AU":63.324,1:"")
I LRFILE1="" S LRQUIT=1 Q
D GETS^DIQ(LRFILE1,LRIENS,"**","Z","^TMP(""DIQ1"",$J)")
Q
;
;
RPT ;
N DIE,DA,DR
;S DIE=DIC K DIC
S DIE=$S(LRSS="AU":"^LR(LRDFN,84,",1:"^LR(LRDFN,LRSS,LRI,1.2,")
S (LRDA,DA)=LRSRDA
S:LRSS="AU" DA(1)=LRDFN
S:LRSS'="AU" DA(1)=LRI,DA(2)=LRDFN
S DR=".01;1" D ^DIE
I 'LRRLS S LRQUIT=1
Q
;
;
QUESP ; Update the preliminary report print queue
N LRIENS
I '$D(^LRO(69.2,LRAA,1,LRAN,0)) D
. K LRFDA
. L +^LRO(69.2,LRAA,1):DILOCKTM
. I '$T D Q
. . S MSG(1)="The preliminary reports queue is in use.",MSG(1,"F")="!!"
. . S MSG(2)="You will need to add this accession to the queue later."
. . D EN^DDIOL(.MSG) K MSG
. S LRIENS="+1,"_LRAA_","
. S LRFDA(69.21,LRIENS,.01)=LRDFN
. S LRFDA(69.21,LRIENS,1)=LRI
. S LRFDA(69.21,LRIENS,2)=LRH(0)
. S LRORIEN(1)=LRAN
. D UPDATE^DIE("","LRFDA","LRORIEN")
. L -^LRO(69.2,LRAA,1)
Q
;
;
COMPARE ; Compare reports
I '$D(^TMP("DIQ1",$J)) S LRQUIT=1 Q
S:LRSS'="AU" LRFILE="^LR(LRDFN,LRSS,LRI,1.2,LRDA,1,"
S:LRSS="AU" LRFILE="^LR(LRDFN,84,LRDA,1,"
I '$D(@(LRFILE_"0)")) D Q
. D:LRRLS1 UNRELEAS
. S LRQUIT=1
S LRA=0,LRFLG=1
F S LRA=$O(@(LRFILE_"LRA)")) Q:'LRA D
. S LRXTMP=@(LRFILE_"LRA,0)")
. S:'$D(^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA,0)) LRFLG=0
. Q:'LRFLG
. S LRYTMP=^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA,0)
. I LRXTMP'=LRYTMP S LRFLG=0
I LRFLG D
. S LRA=0
. F S LRA=$O(^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA)) Q:'LRA D
. . I '$D(@(LRFILE_"LRA,0)")) S LRFLG=0
I LRFLG D
. W $C(7),!!,"No changes were made to the supplementary report."
. K ^TMP("DIQ1",$J)
. S LRQUIT=1
Q
;
;
UNRELEAS ; Unrelease the supplementary report.
K LRFDA
S LRFDA(1,LRFILE1,LRIENS,.02)="@"
D UPDATE^DIE("","LRFDA(1)")
Q
;
;
UPDATE ; File changes
; First, store the date of the change and user ID
D UPDATE^LRPXRM(LRDFN,LRSS,+$G(LRI))
K LRFDA
S X="NOW",%DT="T" D ^%DT S LRNOW=Y
S LRIENS1="+1,"_LRIENS
S LRFILE=$S(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
S:LRFILE="" LRFILE=$S(LRSS="AU":63.3242,1:"")
I LRFILE="" S LRQUIT=1 Q
S LRFDA(1,LRFILE,LRIENS1,.01)=LRNOW
S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ,LRFIELD=1
D UPDATE^DIE("","LRFDA(1)","LRORIEN")
;If E-Sign switch OFF,set 3rd piece .03 SUPP REPORT MODIFIED to 1
; to flag the supp report so it can be released via RS
I 'LRESSW D
. S:LRSS'="AU" $P(^LR(LRDFN,LRSS,LRI,1.2,LRDA,0),"^",3)=1
. S:LRSS="AU" $P(^LR(LRDFN,84,LRDA,0),"^",3)=1
Q
;
;
STORE ; Second, store the original report
S LRIENS2=LRORIEN(1)_","_LRIENS
S LRWPROOT="^TMP(""DIQ1"",$J,LRFILE1,LRIENS,1)"
D WP^DIE(LRFILE,LRIENS2,LRFIELD,"",LRWPROOT)
K ^TMP("DIQ1",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPDSR 6833 printed Nov 22, 2024@17:17:24 Page 2
LRAPDSR ;DALOI/STAFF - AP SUPPLEMENTARY REPORT ENTRY;Dec 17, 2008
+1 ;;5.2;LAB SERVICE;**248,259,295,317,350**;Sep 27, 1994;Build 230
+2 ;
+3 NEW LRYTMP,LRWPROOT,LRRLS,LRRLS1,LRRLS2,LRX,LRIENS,LRFILE1,LRFILE,LRA
+4 NEW LRIENS1,LRXTMP,LRFDA,LRNOW,LRIENS2,LRFIELD,LRORIEN,LRFLG,LRDA,LRQUIT,LRSRDA
+5 ;
MAIN ; Main Subroutine
+1 DO RELEAS1
+2 DO GETRPT
+3 if LRQUIT
QUIT
+4 DO RELEAS2
+5 if LRQUIT
QUIT
+6 if LRRLS
DO COPY
+7 if LRQUIT
QUIT
+8 DO RPT
+9 ;
+10 ; Ask for performing laboratory assignment
+11 DO EDIT^LRRPLU(LRDFN,LRSS,LRI)
+12 ;
+13 ; Add supp report to the PRELIMINARY print queue
+14 DO QUESP
+15 if LRQUIT
QUIT
+16 DO COMPARE
+17 if LRQUIT
QUIT
+18 ;
+19 ; If supp report is already released (LRRLS1) unrelease it only if the E-Sign Switch is ON (LRESSW)
+20 NEW LRESSW
+21 DO GETDATA^LRAPESON(.LRESSW)
+22 IF LRRLS1
IF LRESSW
DO UNRELEAS
+23 DO UPDATE
+24 if LRQUIT
QUIT
+25 DO STORE
+26 QUIT
+27 ;
+28 ;
RELEAS1 ; Is the ENTIRE report already released?
+1 SET (LRRLS,LRRLS1,LRQUIT)=0
+2 IF LRSS="AU"
Begin DoDot:1
+3 SET LRX=$PIECE($GET(^LR(LRDFN,LRSS)),"^",15)
+4 ; Report has not been released so no audit will occur.
if 'LRX
QUIT
+5 WRITE !!,$CHAR(7),"This AUTOPSY has been released. Supplementary report additions/modifications"
+6 WRITE !,"will create an audit trail.",!
+7 ; Report has been released so auditing will occur.
SET LRRLS=1
End DoDot:1
QUIT
+8 SET LRX=$PIECE($GET(^LR(LRDFN,LRSS,LRI,0)),"^",11)
+9 ;
+10 IF LRX
Begin DoDot:1
+11 WRITE $CHAR(7),!!,"This "_$GET(LRAA(1))_" report has been released."
+12 WRITE !,"Supplementary report additions/modifications will create an audit trail.",!
+13 SET LRRLS=1
End DoDot:1
+14 QUIT
+15 ;
+16 ;
GETRPT ; First, select the report
+1 ;
+2 NEW DA,DIC,DO,DIR,DIRUT,DTOUT,DUOUT,LRLAST,LRSFN,LRX,X,Y
+3 ;
+4 SET (X,Y)=0
+5 IF LRSS'="AU"
Begin DoDot:1
+6 FOR
SET X=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,X))
if 'X
QUIT
Begin DoDot:2
+7 SET X(0)=^LR(LRDFN,LRSS,LRI,1.2,X,0)
SET Y=Y+1
+8 SET DIR("A",Y)=Y_" - "_$$FMTE^XLFDT($PIECE(X(0),"^"),"1M")
+9 SET LRSFN=$SELECT(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
+10 IF $PIECE(X(0),"^",2)'=""
SET DIR("A",Y)=DIR("A",Y)_" Released: "_$$EXTERNAL^DILFD(LRSFN,.02,"",$PIECE(X(0),"^",2))
+11 IF $PIECE(X(0),"^",3)'=""
SET DIR("A",Y)=DIR("A",Y)_" Report Modified: "_$$EXTERNAL^DILFD(LRSFN,.03,"",$PIECE(X(0),"^",3))
+12 SET LRX(Y)=X
End DoDot:2
End DoDot:1
+13 ;
+14 IF LRSS="AU"
Begin DoDot:1
+15 FOR
SET X=$ORDER(^LR(LRDFN,84,X))
if 'X
QUIT
Begin DoDot:2
+16 SET X(0)=^LR(LRDFN,84,X,0)
SET Y=Y+1
+17 SET DIR("A",Y)=Y_" - "_$$FMTE^XLFDT($PIECE(X(0),"^"),"1M")
+18 IF $PIECE(X(0),"^",2)'=""
SET DIR("A",Y)=DIR("A",Y)_" Released: "_$$EXTERNAL^DILFD(63.324,.02,"",$PIECE(X(0),"^",2))
+19 IF $PIECE(X(0),"^",3)'=""
SET DIR("A",Y)=DIR("A",Y)_" Report Modified: "_$$EXTERNAL^DILFD(63.324,.03,"",$PIECE(X(0),"^",3))
+20 SET LRX(Y)=X
End DoDot:2
End DoDot:1
+21 ;
+22 SET LRLAST=Y+1
+23 IF LRLAST>1
Begin DoDot:1
+24 SET DIR("A",LRLAST)=LRLAST_" - Add a new SUPPLEMENTARY REPORT"
+25 SET DIR("A")="Select SUPPLEMENTARY REPORT"
+26 SET DIR("?",1)="Enter a number from 1 to "_LRLAST
+27 SET DIR("?")="Select the number of the supplementary report to edit"
+28 SET DIR(0)="NO:1:"_LRLAST_":0"
+29 DO ^DIR
+30 IF Y<1
SET LRQUIT=1
QUIT
End DoDot:1
if LRQUIT
QUIT
+31 ;
+32 ; Selected existing report
+33 IF LRLAST>1
IF Y<LRLAST
SET LRSRDA=LRX(Y)
QUIT
+34 ;
+35 ; Adding new report - ask for new date/time
+36 KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
+37 IF LRLAST=1
WRITE !,"Adding a new SUPPLEMENTARY REPORT"
+38 SET DIR(0)=$SELECT(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="AU":63.324,LRSS="EM":63.207,1:"")_",.01"
+39 DO ^DIR
+40 IF Y<1
SET LRQUIT=1
QUIT
+41 ;
+42 KILL DA,DO,DIC
+43 IF LRSS'="AU"
SET DIC="^LR(LRDFN,LRSS,LRI,1.2,"
SET DA(1)=LRDFN
SET DA=LRI
+44 IF '$TEST
SET DIC="^LR(LRDFN,84,"
SET DA=LRDFN
+45 SET DIC(0)="EF"
SET X=+Y
SET DIC("DR")=".02////0"
+46 DO FILE^DICN
+47 IF Y<1
SET LRQUIT=1
+48 SET LRSRDA=+Y
+49 ;
+50 QUIT
+51 ;
+52 ;
RELEAS2 ; Is the supplementary report already released?
+1 ;
+2 IF LRSS'="AU"
SET LRX=$GET(^LR(LRDFN,LRSS,LRI,1.2,LRSRDA,0))
+3 IF '$TEST
SET LRX=$GET(^LR(LRDFN,84,LRSRDA,0))
+4 SET LRRLS2=+$PIECE(LRX,"^",2)
+5 IF LRRLS2
Begin DoDot:1
+6 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+7 SET DIR(0)="YO"
SET DIR("B")="NO"
+8 SET DIR("A",1)=$CHAR(7)
+9 SET DIR("A",2)="This supplementary report has been released."
+10 SET DIR("A",3)="Additions/modifications will create an audit trail."
+11 SET DIR("A")="Sure you want to update this record"
+12 DO ^DIR
+13 IF Y=1
SET LRRLS1=1
+14 IF '$TEST
SET LRQUIT=1
End DoDot:1
+15 QUIT
+16 ;
+17 ;
COPY ; Make a copy of the current report.
+1 KILL ^TMP("DIQ1",$JOB)
+2 SET LRIENS=LRSRDA_","_$SELECT(LRSS'="AU":LRI_",",1:"")_LRDFN_","
+3 SET LRFILE1=$SELECT(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
+4 if LRFILE1=""
SET LRFILE1=$SELECT(LRSS="AU":63.324,1:"")
+5 IF LRFILE1=""
SET LRQUIT=1
QUIT
+6 DO GETS^DIQ(LRFILE1,LRIENS,"**","Z","^TMP(""DIQ1"",$J)")
+7 QUIT
+8 ;
+9 ;
RPT ;
+1 NEW DIE,DA,DR
+2 ;S DIE=DIC K DIC
+3 SET DIE=$SELECT(LRSS="AU":"^LR(LRDFN,84,",1:"^LR(LRDFN,LRSS,LRI,1.2,")
+4 SET (LRDA,DA)=LRSRDA
+5 if LRSS="AU"
SET DA(1)=LRDFN
+6 if LRSS'="AU"
SET DA(1)=LRI
SET DA(2)=LRDFN
+7 SET DR=".01;1"
DO ^DIE
+8 IF 'LRRLS
SET LRQUIT=1
+9 QUIT
+10 ;
+11 ;
QUESP ; Update the preliminary report print queue
+1 NEW LRIENS
+2 IF '$DATA(^LRO(69.2,LRAA,1,LRAN,0))
Begin DoDot:1
+3 KILL LRFDA
+4 LOCK +^LRO(69.2,LRAA,1):DILOCKTM
+5 IF '$TEST
Begin DoDot:2
+6 SET MSG(1)="The preliminary reports queue is in use."
SET MSG(1,"F")="!!"
+7 SET MSG(2)="You will need to add this accession to the queue later."
+8 DO EN^DDIOL(.MSG)
KILL MSG
End DoDot:2
QUIT
+9 SET LRIENS="+1,"_LRAA_","
+10 SET LRFDA(69.21,LRIENS,.01)=LRDFN
+11 SET LRFDA(69.21,LRIENS,1)=LRI
+12 SET LRFDA(69.21,LRIENS,2)=LRH(0)
+13 SET LRORIEN(1)=LRAN
+14 DO UPDATE^DIE("","LRFDA","LRORIEN")
+15 LOCK -^LRO(69.2,LRAA,1)
End DoDot:1
+16 QUIT
+17 ;
+18 ;
COMPARE ; Compare reports
+1 IF '$DATA(^TMP("DIQ1",$JOB))
SET LRQUIT=1
QUIT
+2 if LRSS'="AU"
SET LRFILE="^LR(LRDFN,LRSS,LRI,1.2,LRDA,1,"
+3 if LRSS="AU"
SET LRFILE="^LR(LRDFN,84,LRDA,1,"
+4 IF '$DATA(@(LRFILE_"0)"))
Begin DoDot:1
+5 if LRRLS1
DO UNRELEAS
+6 SET LRQUIT=1
End DoDot:1
QUIT
+7 SET LRA=0
SET LRFLG=1
+8 FOR
SET LRA=$ORDER(@(LRFILE_"LRA)"))
if 'LRA
QUIT
Begin DoDot:1
+9 SET LRXTMP=@(LRFILE_"LRA,0)")
+10 if '$DATA(^TMP("DIQ1",$JOB,LRFILE1,LRIENS,1,LRA,0))
SET LRFLG=0
+11 if 'LRFLG
QUIT
+12 SET LRYTMP=^TMP("DIQ1",$JOB,LRFILE1,LRIENS,1,LRA,0)
+13 IF LRXTMP'=LRYTMP
SET LRFLG=0
End DoDot:1
+14 IF LRFLG
Begin DoDot:1
+15 SET LRA=0
+16 FOR
SET LRA=$ORDER(^TMP("DIQ1",$JOB,LRFILE1,LRIENS,1,LRA))
if 'LRA
QUIT
Begin DoDot:2
+17 IF '$DATA(@(LRFILE_"LRA,0)"))
SET LRFLG=0
End DoDot:2
End DoDot:1
+18 IF LRFLG
Begin DoDot:1
+19 WRITE $CHAR(7),!!,"No changes were made to the supplementary report."
+20 KILL ^TMP("DIQ1",$JOB)
+21 SET LRQUIT=1
End DoDot:1
+22 QUIT
+23 ;
+24 ;
UNRELEAS ; Unrelease the supplementary report.
+1 KILL LRFDA
+2 SET LRFDA(1,LRFILE1,LRIENS,.02)="@"
+3 DO UPDATE^DIE("","LRFDA(1)")
+4 QUIT
+5 ;
+6 ;
UPDATE ; File changes
+1 ; First, store the date of the change and user ID
+2 DO UPDATE^LRPXRM(LRDFN,LRSS,+$GET(LRI))
+3 KILL LRFDA
+4 SET X="NOW"
SET %DT="T"
DO ^%DT
SET LRNOW=Y
+5 SET LRIENS1="+1,"_LRIENS
+6 SET LRFILE=$SELECT(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
+7 if LRFILE=""
SET LRFILE=$SELECT(LRSS="AU":63.3242,1:"")
+8 IF LRFILE=""
SET LRQUIT=1
QUIT
+9 SET LRFDA(1,LRFILE,LRIENS1,.01)=LRNOW
+10 SET LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
SET LRFIELD=1
+11 DO UPDATE^DIE("","LRFDA(1)","LRORIEN")
+12 ;If E-Sign switch OFF,set 3rd piece .03 SUPP REPORT MODIFIED to 1
+13 ; to flag the supp report so it can be released via RS
+14 IF 'LRESSW
Begin DoDot:1
+15 if LRSS'="AU"
SET $PIECE(^LR(LRDFN,LRSS,LRI,1.2,LRDA,0),"^",3)=1
+16 if LRSS="AU"
SET $PIECE(^LR(LRDFN,84,LRDA,0),"^",3)=1
End DoDot:1
+17 QUIT
+18 ;
+19 ;
STORE ; Second, store the original report
+1 SET LRIENS2=LRORIEN(1)_","_LRIENS
+2 SET LRWPROOT="^TMP(""DIQ1"",$J,LRFILE1,LRIENS,1)"
+3 DO WP^DIE(LRFILE,LRIENS2,LRFIELD,"",LRWPROOT)
+4 KILL ^TMP("DIQ1",$JOB)
+5 QUIT
