LRAPDSR ;DALOI/WTY/KLL - AP SUPPLEMENTARY REPORT ENTRY;12/05/00
;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
;
;;VA LR Patche(s): 248,259,295,317
;
N LRYTMP,LRWPROOT,LRRLS,LRRLS1,LRRLS2,LRX,LRIENS,LRFILE1,LRFILE,LRA
N LRIENS1,LRXTMP,LRFDA,LRNOW,LRIENS2,LRFIELD,LRORIEN,LRFLG,LRDA,LRQUIT
;
MAIN ;Main Subroutine
D RELEAS1
D GETRPT
Q:LRQUIT
D RELEAS2
D:LRRLS COPY
Q:LRQUIT
D RPT
;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,
; but 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 "
.W "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"
.W " an audit trail.",!
.S LRRLS=1
Q
GETRPT ;First, select the report
S DIC(0)="QAEZL",DLAYGO=63
S DIC("A")="Select SUPPLEMENTARY REPORT DATE: "
S DIC=$S(LRSS="AU":"^LR(LRDFN,84,",1:"^LR(LRDFN,LRSS,LRI,1.2,")
S DIC("P")=$S(LRSS="AU":"63,32.4,0",1:"LRSF,1.2,0")
S DIC("P")=$P(@("^DD("_DIC("P")_")"),"^",2)
S DIC("B")="" S LRX=0 F S LRX=$O(@(DIC_"LRX)")) Q:'LRX D
.S DIC("B")=+(@(DIC_"LRX,0)"))
D ^DIC K DLAYGO
S:Y=-1 LRQUIT=1
Q
RELEAS2 ;Is the supplementary report already released?
S LRRLS2=0
S:LRSS'="AU" LRX=$G(^LR(LRDFN,LRSS,LRI,1.2,+Y,0))
S:LRSS="AU" LRX=$G(^LR(LRDFN,84,+Y,0))
S LRRLS2=+$P(LRX,"^",2)
I LRRLS2 D
.W $C(7),!!,"This supplementary report has been released. Additions/"
.W "modifications",!,"will create an audit trail.",!
.S LRRLS1=1
Q
COPY ;Make a copy of the current report.
K ^TMP("DIQ1",$J)
S LRIENS=+Y_","_$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 (LRDA,DA)=+Y
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):5 I '$T D Q
..S MSG(1)="The preliminary reports queue is in use. "
..S 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)) ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
I $$PATCH^BLRUTIL4("PXRM*1.5*12") D UPDATE^LRPXRM(LRDFN,LRSS,+$G(LRI)) ; IHS/MSC/MKK - LR*5.2*1031
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
LRAPDSR ;DALOI/WTY/KLL - AP SUPPLEMENTARY REPORT ENTRY;12/05/00
+1 ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patche(s): 248,259,295,317
+4 ;
+5 NEW LRYTMP,LRWPROOT,LRRLS,LRRLS1,LRRLS2,LRX,LRIENS,LRFILE1,LRFILE,LRA
+6 NEW LRIENS1,LRXTMP,LRFDA,LRNOW,LRIENS2,LRFIELD,LRORIEN,LRFLG,LRDA,LRQUIT
+7 ;
MAIN ;Main Subroutine
+1 DO RELEAS1
+2 DO GETRPT
+3 IF LRQUIT
QUIT
+4 DO RELEAS2
+5 IF LRRLS
DO COPY
+6 IF LRQUIT
QUIT
+7 DO RPT
+8 ;Add supp report to the PRELIMINARY print queue
+9 DO QUESP
+10 IF LRQUIT
QUIT
+11 DO COMPARE
+12 IF LRQUIT
QUIT
+13 ;If supp report is already released (LRRLS1), unrelease it,
+14 ; but only if the E-Sign Switch is ON (LRESSW)
+15 NEW LRESSW
+16 DO GETDATA^LRAPESON(.LRESSW)
+17 IF LRRLS1
IF LRESSW
DO UNRELEAS
+18 DO UPDATE
+19 IF LRQUIT
QUIT
+20 DO STORE
+21 QUIT
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 "
+6 WRITE "additions/modifications"
+7 WRITE !,"will create an audit trail.",!
+8 ;Report has been released so auditing will occur.
SET LRRLS=1
End DoDot:1
QUIT
+9 SET LRX=$PIECE($GET(^LR(LRDFN,LRSS,LRI,0)),"^",11)
+10 ;
+11 IF LRX
Begin DoDot:1
+12 WRITE $CHAR(7),!!,"This "_$GET(LRAA(1))_" report has been released."
+13 WRITE !,"Supplementary report additions/modifications will create"
+14 WRITE " an audit trail.",!
+15 SET LRRLS=1
End DoDot:1
+16 QUIT
GETRPT ;First, select the report
+1 SET DIC(0)="QAEZL"
SET DLAYGO=63
+2 SET DIC("A")="Select SUPPLEMENTARY REPORT DATE: "
+3 SET DIC=$SELECT(LRSS="AU":"^LR(LRDFN,84,",1:"^LR(LRDFN,LRSS,LRI,1.2,")
+4 SET DIC("P")=$SELECT(LRSS="AU":"63,32.4,0",1:"LRSF,1.2,0")
+5 SET DIC("P")=$PIECE(@("^DD("_DIC("P")_")"),"^",2)
+6 SET DIC("B")=""
SET LRX=0
FOR
SET LRX=$ORDER(@(DIC_"LRX)"))
IF 'LRX
QUIT
Begin DoDot:1
+7 SET DIC("B")=+(@(DIC_"LRX,0)"))
End DoDot:1
+8 DO ^DIC
KILL DLAYGO
+9 IF Y=-1
SET LRQUIT=1
+10 QUIT
RELEAS2 ;Is the supplementary report already released?
+1 SET LRRLS2=0
+2 IF LRSS'="AU"
SET LRX=$GET(^LR(LRDFN,LRSS,LRI,1.2,+Y,0))
+3 IF LRSS="AU"
SET LRX=$GET(^LR(LRDFN,84,+Y,0))
+4 SET LRRLS2=+$PIECE(LRX,"^",2)
+5 IF LRRLS2
Begin DoDot:1
+6 WRITE $CHAR(7),!!,"This supplementary report has been released. Additions/"
+7 WRITE "modifications",!,"will create an audit trail.",!
+8 SET LRRLS1=1
End DoDot:1
+9 QUIT
COPY ;Make a copy of the current report.
+1 KILL ^TMP("DIQ1",$JOB)
+2 SET LRIENS=+Y_","_$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
RPT ;
+1 NEW DIE,DA,DR
+2 SET DIE=DIC
KILL DIC
+3 SET (LRDA,DA)=+Y
+4 IF LRSS="AU"
SET DA(1)=LRDFN
+5 IF LRSS'="AU"
SET DA(1)=LRI
SET DA(2)=LRDFN
+6 SET DR=".01;1"
DO ^DIE
+7 IF 'LRRLS
SET LRQUIT=1
+8 QUIT
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):5
IF '$TEST
Begin DoDot:2
+5 SET MSG(1)="The preliminary reports queue is in use. "
+6 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
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
FOR
SET LRA=$ORDER(^TMP("DIQ1",$JOB,LRFILE1,LRIENS,1,LRA))
IF 'LRA
QUIT
Begin DoDot:2
+16 IF '$DATA(@(LRFILE_"LRA,0)"))
SET LRFLG=0
End DoDot:2
End DoDot:1
+17 IF LRFLG
Begin DoDot:1
+18 WRITE $CHAR(7),!!,"No changes were made to the supplementary report."
+19 KILL ^TMP("DIQ1",$JOB)
+20 SET LRQUIT=1
End DoDot:1
+21 QUIT
UNRELEAS ;Unrelease the supplementary report.
+1 KILL LRFDA
+2 SET LRFDA(1,LRFILE1,LRIENS,.02)="@"
+3 DO UPDATE^DIE("","LRFDA(1)")
+4 QUIT
UPDATE ;File changes
+1 ;First, store the date of the change and user ID
+2 ; D UPDATE^LRPXRM(LRDFN,LRSS,+$G(LRI)) ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
+3 ; IHS/MSC/MKK - LR*5.2*1031
IF $$PATCH^BLRUTIL4("PXRM*1.5*12")
DO UPDATE^LRPXRM(LRDFN,LRSS,+$GET(LRI))
+4 KILL LRFDA
+5 SET X="NOW"
SET %DT="T"
DO ^%DT
SET LRNOW=Y
+6 SET LRIENS1="+1,"_LRIENS
+7 SET LRFILE=$SELECT(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
+8 IF LRFILE=""
SET LRFILE=$SELECT(LRSS="AU":63.3242,1:"")
+9 IF LRFILE=""
SET LRQUIT=1
QUIT
+10 SET LRFDA(1,LRFILE,LRIENS1,.01)=LRNOW
+11 SET LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
SET LRFIELD=1
+12 DO UPDATE^DIE("","LRFDA(1)","LRORIEN")
+13 ;If E-Sign switch OFF,set 3rd piece .03 SUPP REPORT MODIFIED to 1
+14 ; to flag the supp report so it can be released via RS
+15 IF 'LRESSW
Begin DoDot:1
+16 IF LRSS'="AU"
SET $PIECE(^LR(LRDFN,LRSS,LRI,1.2,LRDA,0),"^",3)=1
+17 IF LRSS="AU"
SET $PIECE(^LR(LRDFN,84,LRDA,0),"^",3)=1
End DoDot:1
+18 QUIT
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
