LRAPMRL ;DALOI/STAFF - AP MODIFY RELEASED REPORT;02/28/12 20:38
;;5.2;LAB SERVICE;**259,295,317,368,397,350**;Sep 27, 1994;Build 230
;
MAIN ;
N LRQUIT,LRMSG,LREND,LRDATA,LRREL,LRAU,LREFPD,LRWM,LRCT,LRTMP,LRGMDF
N LRFLD,LRDSC,LRCHG,LRXTMP,LRYTMP,LRIENS1,LRFILE,LRFLDA,LRAD1,LRIENS
N LRORIEN,LRWPROOT,LRFDA,LRDA,LRFIELD,LRFILE1,LRIENS2,LRDT0,LRESCPT
N LRQUIT1,LREDIAG,LRLOCK,LRNOTXT,LRORIEN,LRSEL
S LRESCPT=0
D TITLE
I LRQUIT D END Q
D NOTICE
I LRQUIT D END Q
D SECTION
I LRQUIT D END Q
D WHAT
I LRQUIT D END Q
D CPTCHK
;D SECTION
I LRQUIT D END Q
D ASK
I LRQUIT D END Q
D SETDR^LRAPMRL1
D ACCYR
I LRQUIT D END Q
D ACCPN
D END
D V^LRU
Q
;
;
ACCPN ; Prompt for accession number or patient name or UID
F D Q:LREND
. S (LRQUIT,LREND)=0
. D CPTCHK
. D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
. I LRSEL=3,$D(X) I X=""!(X[U) S LREND=1 Q
. I '$D(LRSEL)!(LRDATA<1)!('$G(LRAN))!($G(LRAN)=-1) S LREND=1 Q
. I 'LRSEL S LREND=1 Q
. S LRDFN=LRDATA,LRI=LRDATA(1)
. S LRLOCK="^LR(LRDFN"_$S(LRAU:")",1:",LRSS,LRI)")
. L +@(LRLOCK):DILOCKTM I '$T D Q
. . S LRMSG="This record is locked by another user. "
. . S LRMSG=LRMSG_"Please try again later."
. . D EN^DDIOL(LRMSG,"","!!") K LRMSG
. S LRIENS=$S('LRAU:LRI_",",1:"")_LRDFN_","
. D RELCHK^LRAPMRL1
. I LRQUIT D UNLOCK Q
. D RELEASE^LRAPMRL1
. D QUEUPD^LRAPMRL1
. D:LRCAPA C^LRAPSWK
. D:'LREDIAG SETDR^LRAPMRL1,EDIT^LRAPMRL1
. I LRQUIT D UNLOCK Q
. I 'LRAU D
. . F LRFLD=1,1.1,1.4,1.3 D Q:LRQUIT
. . . Q:LREDIAG&(LRFLD'=1.4)
. . . Q:'LREDIAG&(LRFLD=1.4)
. . . Q:LRFLD=1.3&(LRSS'="SP")
. . . D ASK2 Q:LRQUIT!('LRGMDF)
. . . D SAVTXT
. . . K DR S DR=LRFLD
. . . D EDIT^LRAPMRL1
. . . D COMPARE Q:LRQUIT
. . . D AUDIT Q:LRQUIT
. . . D STORE
. I LRAU,LREDIAG D
. . S LRDSC="PATHOLOGICAL DIAGNOSIS"
. . S LRFLD=32.3
. . D SAVTXT
. . K DR S DR=LRFLD
. . D EDIT^LRAPMRL1
. . D COMPARE
. I $G(SEX)["F","SPCY"[LRSS D DEL^LRWOMEN
. I LRQUIT D UNLOCK Q
. I LREDIAG D UNLOCK Q
. D:LRESCPT CPTCODE^LRAPMRL1
. D UNLOCK
Q
;
;
TITLE ; Title
S (LRQUIT,LRQUIT1)=0
D CK^LRAP
I Y=-1 S LRQUIT=1 Q
W @IOF
S LRMSG="Modify Released Pathology Reports"
S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM)
S LRMSG(1,"F")="!!"
S LRMSG(2)="",LRMSG(2,"F")="!"
D EN^DDIOL(.LRMSG) K LRMSG
Q
;
;
NOTICE ; Warn the user and allow an exit
N LRMSG
S LRMSG(1)=$$CJ^XLFSTR("NOTICE",IOM),LRMSG(1,"F")="!!"
S LRMSG(2)=" ",LRMSG(2,"F")="!"
S LRMSG(3)=$C(7)_"This option allows modification of a verified/released pathology report.",LRMSG(3,"F")="!?3"
S LRMSG(4)="Continuing with this option will unrelease the report and flag the report",LRMSG(4,"F")="!?3"
S LRMSG(5)="as modified even if the data is unchanged. It will also be queued to the",LRMSG(5,"F")="!?3"
S LRMSG(6)="final report queue so that it may be verified/released again.",LRMSG(6,"F")="!?3"
D EN^DDIOL(.LRMSG)
W !!
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
D ^DIR
S:Y<1 LRQUIT=1
Q
;
;
WHAT ; What is to be edited
N XASK
W !
K DIR
; Don't ask to Edit Diagnosis if initial entry of diagnosis is turned off at data entry for SP, CY, EM's
S LRASK=1,XASK=""
I 'LRAU D
. S XASK=$S(LRSS="SP":11.2,LRSS="CY":11.3,1:"")
. S:XASK="" XASK=$S(LRSS="EM":11.4,1:"")
. S LRASK=$$GET1^DIQ(69.9,"1,",XASK,"I")
S:LRASK DIR(0)="S^1:Edit Report;2:Edit Diagnosis"
S:LRASK DIR("A")="Enter selection",DIR("B")=1
S:'LRASK DIR(0)="Y",DIR("B")="YES",DIR("A")="Edit Report?"
D ^DIR
I $D(DIRUT) S LRQUIT=1 Q
S LREDIAG=$S(Y=2:1,1:0)
Q
;
;
CPTCHK ; Determine if CPT is activated
Q:$T(ES^LRCAPES)=""
S LRESCPT=$$ES^LRCAPES()
Q
;
;
SECTION ; Choose Anatomic Pathology section (AU,SP,CY,EM)
W !
D ^LRAP
I '$D(Y)!('$D(LRSS)) S LRQUIT=1 Q
S:LRO(68)="EM" LRO(68)="ELECTRON MICROSCOPY"
S LRAU=0 ; LRAU = 0 - Not Autopsy
S:LRSS="AU" LRAU=1 ; = 1 - Autopsy
I LRCAPA D @(LRSS_"^LRAPSWK")
S LRMSG(1)=LRO(68)_" ("_LRABV_")",LRMSG(1,"F")="!?20"
S LRMSG(2)="",LRMSG(2,"F")="!"
D EN^DDIOL(.LRMSG) K LRMSG
Q
;
;
ASK ; Ask etiology,function,procedure,disease,weights,measures
I LREDIAG D Q
. S:'LRAU LREFPD=0
. S:LRAU LRWM=0
W !
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Edit etiology, function, procedure & disease"
D ^DIR
I Y="^" S LRQUIT=1 Q
S LREFPD=$S(+Y:1,1:0)
I LRAU D
. W !
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Edit weights and measures"
. D ^DIR
. I Y="^" S LRQUIT=1 Q
. S LRWM=$S(+Y:1,1:0)
Q
;
;
ACCYR ; Determine Accession Year
D ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
I LRAD1=-1 S LRQUIT=1 Q
I LRAD1 S LRAD=$P(LRAD1,U),LRH(0)=$P(LRAD1,U,2)
Q
;
;
ASK2 ; Ask about other fields
S LRGMDF=0
K LRDSC
I LRFLD=1!(LRFLD=1.1) D
. S:LRFLD=1 LRFLDA=7
. S:LRFLD=1.1 LRFLDA=4
. S LRDSC=$S(LRFLD=1:"GROSS",LRFLD=1.1:"MICROSCOPIC",1:"")
. S LRDSC=LRDSC_" DESCRIPTION"
S:LRFLD=1.4 LRDSC="DIAGNOSIS",LRFLDA=5
S:LRFLD=1.3 LRDSC="FROZEN SECTION",LRFLDA=6
I 'LREDIAG D
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Edit "_LRDSC
. D ^DIR
. I Y="^" S LRQUIT=1 Q
. S LRGMDF=$S(+Y:1,1:0)
S:LREDIAG LRGMDF=1
Q
;
;
SAVTXT ; Save word processing field text.
S LRNOTXT=0
K ^TMP("DIQ1",$J)
S:'LRAU LRIENS=LRI_","_LRDFN_",",LRFILE=LRSF
S:LRAU LRIENS=LRDFN_",",LRFILE=63
Q:LRFLD=""
S LRTMP=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","^TMP(""DIQ1"",$J)")
I LRTMP="" D
. N LRMSG
. S LRMSG(1)="There is no "_LRDSC_" text to modify.",LRMSG(1,"F")="!!"
. S LRMSG(2)="Report was released before entering text.",LRMSG(2,"F")="!"
. D EN^DDIOL(.LRMSG)
. S LRNOTXT=1
Q
;
;
COMPARE ; Compare report text
S (LRCHG,LRQUIT,LRCT)=0
S:'LRAU LRFILE="^LR(LRDFN,LRSS,LRI,LRFLD,"
S:LRAU LRFILE="^LR(LRDFN,82,"
I '$D(@(LRFILE_"0)")) D Q
. Q:LRNOTXT
. S LRQUIT=1
F S LRCT=$O(@(LRFILE_"LRCT)")) Q:'LRCT D
. S LRXTMP=@(LRFILE_"LRCT,0)")
. I '$D(^TMP("DIQ1",$J,LRCT)) S LRCHG=1 Q
. S LRYTMP=^TMP("DIQ1",$J,LRCT)
. I LRXTMP'=LRYTMP S LRCHG=1
;
I 'LRCHG D
. S LRCT=0 F S LRCT=$O(^TMP("DIQ1",$J,LRCT)) Q:'LRCT D
. . I '$D(@(LRFILE_"LRCT,0)")) S LRCHG=1
;
I 'LRCHG D Q
. D EN^DDIOL("No changes made to "_LRDSC_".","","!!")
. W !
. K ^TMP("DIQ1",$J)
;
; Indicate that the diagnosis has been modified.
I LRCHG&(LRFLD=1.4!(LRFLD=32.3)) D
. K LRFDA
. S:'LRAU LRFDA(LRSF,LRIENS,.172)=1
. ;KLL-CORRECT BUG WHERE LRSF IS NULL, REPLACE LRSF WITH 63
. S:LRAU LRFDA(63,LRIENS,102.2)=1
. ;S:LRAU LRFDA(LRSF,LRIENS,102.2)=1
. D FILE^DIE("","LRFDA")
;
Q
;
;
AUDIT ;
N LRNTIME
K LRFDA
D NOW^%DTC S LRNTIME=%
S LRIENS1="+1,"_LRIENS
S LRFILE=+$$GET1^DID(LRSF,LRFLDA,"","SPECIFIER")
I LRFILE="" S LRQUIT=1 Q
S LRFDA(1,LRFILE,LRIENS1,.01)=LRNTIME
S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
D UPDATE^DIE("","LRFDA(1)","LRORIEN")
Q
;
;
STORE ;
K LRIENS1
S LRIENS1=LRORIEN(1)_","_LRIENS
S LRWPROOT="^TMP(""DIQ1"",$J)"
D WP^DIE(LRFILE,LRIENS1,1,"",LRWPROOT)
K ^TMP("DIQ1",$J),LRORIEN
Q
;
;
SUPRPT ; Supplementary Report
K DIR
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Edit SUPPLEMENTARY REPORTS"
D ^DIR
I Y="^" S LRQUIT1=1 Q
Q:Y<1
N LRX,LRRLS,LRA,LRFLG,LRNOW
D GETRPT^LRAPDSR Q:LRQUIT
S LRRLS=1,LRRLS1=0
D COPY^LRAPDSR Q:LRQUIT
D RPT^LRAPDSR Q:LRQUIT
S Y=LRDA
D RELEAS2^LRAPDSR
D COMPARE^LRAPDSR Q:LRQUIT
D UNRELEAS^LRAPDSR
D UPDATE^LRAPDSR Q:LRQUIT
D STORE^LRAPDSR
Q
;
;
UNLOCK ; Unlock the record
D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))
L -@(LRLOCK)
Q
;
;
END ; Clean-up variables and quit
K ^TMP("LRAPBR",$J),^TMP("TIUP",$J)
D CLEAN^DILF
D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES
D V^LRU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPMRL 7745 printed Sep 23, 2025@19:43:22 Page 2
LRAPMRL ;DALOI/STAFF - AP MODIFY RELEASED REPORT;02/28/12 20:38
+1 ;;5.2;LAB SERVICE;**259,295,317,368,397,350**;Sep 27, 1994;Build 230
+2 ;
MAIN ;
+1 NEW LRQUIT,LRMSG,LREND,LRDATA,LRREL,LRAU,LREFPD,LRWM,LRCT,LRTMP,LRGMDF
+2 NEW LRFLD,LRDSC,LRCHG,LRXTMP,LRYTMP,LRIENS1,LRFILE,LRFLDA,LRAD1,LRIENS
+3 NEW LRORIEN,LRWPROOT,LRFDA,LRDA,LRFIELD,LRFILE1,LRIENS2,LRDT0,LRESCPT
+4 NEW LRQUIT1,LREDIAG,LRLOCK,LRNOTXT,LRORIEN,LRSEL
+5 SET LRESCPT=0
+6 DO TITLE
+7 IF LRQUIT
DO END
QUIT
+8 DO NOTICE
+9 IF LRQUIT
DO END
QUIT
+10 DO SECTION
+11 IF LRQUIT
DO END
QUIT
+12 DO WHAT
+13 IF LRQUIT
DO END
QUIT
+14 DO CPTCHK
+15 ;D SECTION
+16 IF LRQUIT
DO END
QUIT
+17 DO ASK
+18 IF LRQUIT
DO END
QUIT
+19 DO SETDR^LRAPMRL1
+20 DO ACCYR
+21 IF LRQUIT
DO END
QUIT
+22 DO ACCPN
+23 DO END
+24 DO V^LRU
+25 QUIT
+26 ;
+27 ;
ACCPN ; Prompt for accession number or patient name or UID
+1 FOR
Begin DoDot:1
+2 SET (LRQUIT,LREND)=0
+3 DO CPTCHK
+4 DO LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
+5 IF LRSEL=3
IF $DATA(X)
IF X=""!(X[U)
SET LREND=1
QUIT
+6 IF '$DATA(LRSEL)!(LRDATA<1)!('$GET(LRAN))!($GET(LRAN)=-1)
SET LREND=1
QUIT
+7 IF 'LRSEL
SET LREND=1
QUIT
+8 SET LRDFN=LRDATA
SET LRI=LRDATA(1)
+9 SET LRLOCK="^LR(LRDFN"_$SELECT(LRAU:")",1:",LRSS,LRI)")
+10 LOCK +@(LRLOCK):DILOCKTM
IF '$TEST
Begin DoDot:2
+11 SET LRMSG="This record is locked by another user. "
+12 SET LRMSG=LRMSG_"Please try again later."
+13 DO EN^DDIOL(LRMSG,"","!!")
KILL LRMSG
End DoDot:2
QUIT
+14 SET LRIENS=$SELECT('LRAU:LRI_",",1:"")_LRDFN_","
+15 DO RELCHK^LRAPMRL1
+16 IF LRQUIT
DO UNLOCK
QUIT
+17 DO RELEASE^LRAPMRL1
+18 DO QUEUPD^LRAPMRL1
+19 if LRCAPA
DO C^LRAPSWK
+20 if 'LREDIAG
DO SETDR^LRAPMRL1
DO EDIT^LRAPMRL1
+21 IF LRQUIT
DO UNLOCK
QUIT
+22 IF 'LRAU
Begin DoDot:2
+23 FOR LRFLD=1,1.1,1.4,1.3
Begin DoDot:3
+24 if LREDIAG&(LRFLD'=1.4)
QUIT
+25 if 'LREDIAG&(LRFLD=1.4)
QUIT
+26 if LRFLD=1.3&(LRSS'="SP")
QUIT
+27 DO ASK2
if LRQUIT!('LRGMDF)
QUIT
+28 DO SAVTXT
+29 KILL DR
SET DR=LRFLD
+30 DO EDIT^LRAPMRL1
+31 DO COMPARE
if LRQUIT
QUIT
+32 DO AUDIT
if LRQUIT
QUIT
+33 DO STORE
End DoDot:3
if LRQUIT
QUIT
End DoDot:2
+34 IF LRAU
IF LREDIAG
Begin DoDot:2
+35 SET LRDSC="PATHOLOGICAL DIAGNOSIS"
+36 SET LRFLD=32.3
+37 DO SAVTXT
+38 KILL DR
SET DR=LRFLD
+39 DO EDIT^LRAPMRL1
+40 DO COMPARE
End DoDot:2
+41 IF $GET(SEX)["F"
IF "SPCY"[LRSS
DO DEL^LRWOMEN
+42 IF LRQUIT
DO UNLOCK
QUIT
+43 IF LREDIAG
DO UNLOCK
QUIT
+44 if LRESCPT
DO CPTCODE^LRAPMRL1
+45 DO UNLOCK
End DoDot:1
if LREND
QUIT
+46 QUIT
+47 ;
+48 ;
TITLE ; Title
+1 SET (LRQUIT,LRQUIT1)=0
+2 DO CK^LRAP
+3 IF Y=-1
SET LRQUIT=1
QUIT
+4 WRITE @IOF
+5 SET LRMSG="Modify Released Pathology Reports"
+6 SET LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM)
+7 SET LRMSG(1,"F")="!!"
+8 SET LRMSG(2)=""
SET LRMSG(2,"F")="!"
+9 DO EN^DDIOL(.LRMSG)
KILL LRMSG
+10 QUIT
+11 ;
+12 ;
NOTICE ; Warn the user and allow an exit
+1 NEW LRMSG
+2 SET LRMSG(1)=$$CJ^XLFSTR("NOTICE",IOM)
SET LRMSG(1,"F")="!!"
+3 SET LRMSG(2)=" "
SET LRMSG(2,"F")="!"
+4 SET LRMSG(3)=$CHAR(7)_"This option allows modification of a verified/released pathology report."
SET LRMSG(3,"F")="!?3"
+5 SET LRMSG(4)="Continuing with this option will unrelease the report and flag the report"
SET LRMSG(4,"F")="!?3"
+6 SET LRMSG(5)="as modified even if the data is unchanged. It will also be queued to the"
SET LRMSG(5,"F")="!?3"
+7 SET LRMSG(6)="final report queue so that it may be verified/released again."
SET LRMSG(6,"F")="!?3"
+8 DO EN^DDIOL(.LRMSG)
+9 WRITE !!
+10 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="NO"
+11 DO ^DIR
+12 if Y<1
SET LRQUIT=1
+13 QUIT
+14 ;
+15 ;
WHAT ; What is to be edited
+1 NEW XASK
+2 WRITE !
+3 KILL DIR
+4 ; Don't ask to Edit Diagnosis if initial entry of diagnosis is turned off at data entry for SP, CY, EM's
+5 SET LRASK=1
SET XASK=""
+6 IF 'LRAU
Begin DoDot:1
+7 SET XASK=$SELECT(LRSS="SP":11.2,LRSS="CY":11.3,1:"")
+8 if XASK=""
SET XASK=$SELECT(LRSS="EM":11.4,1:"")
+9 SET LRASK=$$GET1^DIQ(69.9,"1,",XASK,"I")
End DoDot:1
+10 if LRASK
SET DIR(0)="S^1:Edit Report;2:Edit Diagnosis"
+11 if LRASK
SET DIR("A")="Enter selection"
SET DIR("B")=1
+12 if 'LRASK
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Edit Report?"
+13 DO ^DIR
+14 IF $DATA(DIRUT)
SET LRQUIT=1
QUIT
+15 SET LREDIAG=$SELECT(Y=2:1,1:0)
+16 QUIT
+17 ;
+18 ;
CPTCHK ; Determine if CPT is activated
+1 if $TEXT(ES^LRCAPES)=""
QUIT
+2 SET LRESCPT=$$ES^LRCAPES()
+3 QUIT
+4 ;
+5 ;
SECTION ; Choose Anatomic Pathology section (AU,SP,CY,EM)
+1 WRITE !
+2 DO ^LRAP
+3 IF '$DATA(Y)!('$DATA(LRSS))
SET LRQUIT=1
QUIT
+4 if LRO(68)="EM"
SET LRO(68)="ELECTRON MICROSCOPY"
+5 ; LRAU = 0 - Not Autopsy
SET LRAU=0
+6 ; = 1 - Autopsy
if LRSS="AU"
SET LRAU=1
+7 IF LRCAPA
DO @(LRSS_"^LRAPSWK")
+8 SET LRMSG(1)=LRO(68)_" ("_LRABV_")"
SET LRMSG(1,"F")="!?20"
+9 SET LRMSG(2)=""
SET LRMSG(2,"F")="!"
+10 DO EN^DDIOL(.LRMSG)
KILL LRMSG
+11 QUIT
+12 ;
+13 ;
ASK ; Ask etiology,function,procedure,disease,weights,measures
+1 IF LREDIAG
Begin DoDot:1
+2 if 'LRAU
SET LREFPD=0
+3 if LRAU
SET LRWM=0
End DoDot:1
QUIT
+4 WRITE !
+5 SET DIR(0)="Y"
SET DIR("B")="NO"
+6 SET DIR("A")="Edit etiology, function, procedure & disease"
+7 DO ^DIR
+8 IF Y="^"
SET LRQUIT=1
QUIT
+9 SET LREFPD=$SELECT(+Y:1,1:0)
+10 IF LRAU
Begin DoDot:1
+11 WRITE !
+12 SET DIR(0)="Y"
SET DIR("B")="NO"
+13 SET DIR("A")="Edit weights and measures"
+14 DO ^DIR
+15 IF Y="^"
SET LRQUIT=1
QUIT
+16 SET LRWM=$SELECT(+Y:1,1:0)
End DoDot:1
+17 QUIT
+18 ;
+19 ;
ACCYR ; Determine Accession Year
+1 DO ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
+2 IF LRAD1=-1
SET LRQUIT=1
QUIT
+3 IF LRAD1
SET LRAD=$PIECE(LRAD1,U)
SET LRH(0)=$PIECE(LRAD1,U,2)
+4 QUIT
+5 ;
+6 ;
ASK2 ; Ask about other fields
+1 SET LRGMDF=0
+2 KILL LRDSC
+3 IF LRFLD=1!(LRFLD=1.1)
Begin DoDot:1
+4 if LRFLD=1
SET LRFLDA=7
+5 if LRFLD=1.1
SET LRFLDA=4
+6 SET LRDSC=$SELECT(LRFLD=1:"GROSS",LRFLD=1.1:"MICROSCOPIC",1:"")
+7 SET LRDSC=LRDSC_" DESCRIPTION"
End DoDot:1
+8 if LRFLD=1.4
SET LRDSC="DIAGNOSIS"
SET LRFLDA=5
+9 if LRFLD=1.3
SET LRDSC="FROZEN SECTION"
SET LRFLDA=6
+10 IF 'LREDIAG
Begin DoDot:1
+11 SET DIR(0)="Y"
SET DIR("B")="NO"
+12 SET DIR("A")="Edit "_LRDSC
+13 DO ^DIR
+14 IF Y="^"
SET LRQUIT=1
QUIT
+15 SET LRGMDF=$SELECT(+Y:1,1:0)
End DoDot:1
+16 if LREDIAG
SET LRGMDF=1
+17 QUIT
+18 ;
+19 ;
SAVTXT ; Save word processing field text.
+1 SET LRNOTXT=0
+2 KILL ^TMP("DIQ1",$JOB)
+3 if 'LRAU
SET LRIENS=LRI_","_LRDFN_","
SET LRFILE=LRSF
+4 if LRAU
SET LRIENS=LRDFN_","
SET LRFILE=63
+5 if LRFLD=""
QUIT
+6 SET LRTMP=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","^TMP(""DIQ1"",$J)")
+7 IF LRTMP=""
Begin DoDot:1
+8 NEW LRMSG
+9 SET LRMSG(1)="There is no "_LRDSC_" text to modify."
SET LRMSG(1,"F")="!!"
+10 SET LRMSG(2)="Report was released before entering text."
SET LRMSG(2,"F")="!"
+11 DO EN^DDIOL(.LRMSG)
+12 SET LRNOTXT=1
End DoDot:1
+13 QUIT
+14 ;
+15 ;
COMPARE ; Compare report text
+1 SET (LRCHG,LRQUIT,LRCT)=0
+2 if 'LRAU
SET LRFILE="^LR(LRDFN,LRSS,LRI,LRFLD,"
+3 if LRAU
SET LRFILE="^LR(LRDFN,82,"
+4 IF '$DATA(@(LRFILE_"0)"))
Begin DoDot:1
+5 if LRNOTXT
QUIT
+6 SET LRQUIT=1
End DoDot:1
QUIT
+7 FOR
SET LRCT=$ORDER(@(LRFILE_"LRCT)"))
if 'LRCT
QUIT
Begin DoDot:1
+8 SET LRXTMP=@(LRFILE_"LRCT,0)")
+9 IF '$DATA(^TMP("DIQ1",$JOB,LRCT))
SET LRCHG=1
QUIT
+10 SET LRYTMP=^TMP("DIQ1",$JOB,LRCT)
+11 IF LRXTMP'=LRYTMP
SET LRCHG=1
End DoDot:1
+12 ;
+13 IF 'LRCHG
Begin DoDot:1
+14 SET LRCT=0
FOR
SET LRCT=$ORDER(^TMP("DIQ1",$JOB,LRCT))
if 'LRCT
QUIT
Begin DoDot:2
+15 IF '$DATA(@(LRFILE_"LRCT,0)"))
SET LRCHG=1
End DoDot:2
End DoDot:1
+16 ;
+17 IF 'LRCHG
Begin DoDot:1
+18 DO EN^DDIOL("No changes made to "_LRDSC_".","","!!")
+19 WRITE !
+20 KILL ^TMP("DIQ1",$JOB)
End DoDot:1
QUIT
+21 ;
+22 ; Indicate that the diagnosis has been modified.
+23 IF LRCHG&(LRFLD=1.4!(LRFLD=32.3))
Begin DoDot:1
+24 KILL LRFDA
+25 if 'LRAU
SET LRFDA(LRSF,LRIENS,.172)=1
+26 ;KLL-CORRECT BUG WHERE LRSF IS NULL, REPLACE LRSF WITH 63
+27 if LRAU
SET LRFDA(63,LRIENS,102.2)=1
+28 ;S:LRAU LRFDA(LRSF,LRIENS,102.2)=1
+29 DO FILE^DIE("","LRFDA")
End DoDot:1
+30 ;
+31 QUIT
+32 ;
+33 ;
AUDIT ;
+1 NEW LRNTIME
+2 KILL LRFDA
+3 DO NOW^%DTC
SET LRNTIME=%
+4 SET LRIENS1="+1,"_LRIENS
+5 SET LRFILE=+$$GET1^DID(LRSF,LRFLDA,"","SPECIFIER")
+6 IF LRFILE=""
SET LRQUIT=1
QUIT
+7 SET LRFDA(1,LRFILE,LRIENS1,.01)=LRNTIME
+8 SET LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
+9 DO UPDATE^DIE("","LRFDA(1)","LRORIEN")
+10 QUIT
+11 ;
+12 ;
STORE ;
+1 KILL LRIENS1
+2 SET LRIENS1=LRORIEN(1)_","_LRIENS
+3 SET LRWPROOT="^TMP(""DIQ1"",$J)"
+4 DO WP^DIE(LRFILE,LRIENS1,1,"",LRWPROOT)
+5 KILL ^TMP("DIQ1",$JOB),LRORIEN
+6 QUIT
+7 ;
+8 ;
SUPRPT ; Supplementary Report
+1 KILL DIR
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
+3 SET DIR("A")="Edit SUPPLEMENTARY REPORTS"
+4 DO ^DIR
+5 IF Y="^"
SET LRQUIT1=1
QUIT
+6 if Y<1
QUIT
+7 NEW LRX,LRRLS,LRA,LRFLG,LRNOW
+8 DO GETRPT^LRAPDSR
if LRQUIT
QUIT
+9 SET LRRLS=1
SET LRRLS1=0
+10 DO COPY^LRAPDSR
if LRQUIT
QUIT
+11 DO RPT^LRAPDSR
if LRQUIT
QUIT
+12 SET Y=LRDA
+13 DO RELEAS2^LRAPDSR
+14 DO COMPARE^LRAPDSR
if LRQUIT
QUIT
+15 DO UNRELEAS^LRAPDSR
+16 DO UPDATE^LRAPDSR
if LRQUIT
QUIT
+17 DO STORE^LRAPDSR
+18 QUIT
+19 ;
+20 ;
UNLOCK ; Unlock the record
+1 DO UPDATE^LRPXRM(LRDFN,$GET(LRSS,"AU"),$GET(LRI))
+2 LOCK -@(LRLOCK)
+3 QUIT
+4 ;
+5 ;
END ; Clean-up variables and quit
+1 KILL ^TMP("LRAPBR",$JOB),^TMP("TIUP",$JOB)
+2 DO CLEAN^DILF
+3 if $TEXT(CLEAN^LRCAPES)'=""
DO CLEAN^LRCAPES
+4 DO V^LRU
+5 QUIT
