Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRAPMRL

LRAPMRL.m

Go to the documentation of this file. 
  1. LRAPMRL ;DALOI/WTY/KLL- AP MODIFY RELEASED REPORT; 17-Oct-2014 09:22 ; MKK
  1.  ;;5.2;LAB SERVICE;**259,295,317,1030,368,1031,397,1033,1034**;NOV 1, 1997;Build 88
  1.  ;
  1. MAIN ;
  1.  N LRQUIT,LRMSG,LREND,LRDATA,LRREL,LRAU,LREFPD,LRWM,LRCT,LRTMP,LRGMDF
  1.  N LRFLD,LRDSC,LRCHG,LRXTMP,LRYTMP,LRIENS1,LRFILE,LRFLDA,LRAD1,LRIENS
  1.  N LRORIEN,LRWPROOT,LRFDA,LRDA,LRFIELD,LRFILE1,LRIENS2,LRDT0,LRESCPT
  1.  N LRQUIT1,LREDIAG,LRLOCK,LRNOTXT,LRORIEN
  1.  S LRESCPT=0
  1.  D TITLE
  1.  I LRQUIT D END Q
  1.  D NOTICE
  1.  I LRQUIT D END Q
  1.  D SECTION
  1.  I LRQUIT D END Q
  1.  D WHAT
  1.  I LRQUIT D END Q
  1.  D CPTCHK
  1.  ;D SECTION
  1.  I LRQUIT D END Q
  1.  D ASK
  1.  I LRQUIT D END Q
  1.  D SETDR^LRAPMRL1
  1.  D ACCYR
  1.  I LRQUIT D END Q
  1.  D ACCPN
  1.  D END
  1.  Q
  1. ACCPN ;Prompt for accesion number or patient name
  1.  F  D  Q:LREND
  1.  .S (LRQUIT,LREND)=0
  1.  .D CPTCHK
  1.  .D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
  1.  .I (LRDATA<1)!('$G(LRAN))!($G(LRAN)=-1) S LREND=1 Q
  1.  .S LRDFN=LRDATA,LRI=LRDATA(1)
  1.  .S LRLOCK="^LR(LRDFN"_$S(LRAU:")",1:",LRSS,LRI)")
  1.  .L +@(LRLOCK):5 I '$T D  Q
  1.  ..S LRMSG="This record is locked by another user.  "
  1.  ..S LRMSG=LRMSG_"Please try again later."
  1.  ..D EN^DDIOL(LRMSG,"","!!") K LRMSG
  1.  .S LRIENS=$S('LRAU:LRI_",",1:"")_LRDFN_","
  1.  .D RELCHK^LRAPMRL1
  1.  .I LRQUIT D UNLOCK Q
  1.  .D RELEASE^LRAPMRL1
  1.  .D QUEUPD^LRAPMRL1
  1.  .D:LRCAPA&'LRAU C^LRAPSWK
  1.  .D:'LREDIAG SETDR^LRAPMRL1,EDIT^LRAPMRL1
  1.  .I LRQUIT D UNLOCK Q
  1.  .I 'LRAU D
  1.  ..F LRFLD=1,1.1,1.4,1.3 D  Q:LRQUIT
  1.  ...Q:LREDIAG&(LRFLD'=1.4)
  1.  ...Q:'LREDIAG&(LRFLD=1.4)
  1.  ...Q:LRFLD=1.3&(LRSS'="SP")
  1.  ...D ASK2 Q:LRQUIT!('LRGMDF)
  1.  ...D SAVTXT
  1.  ...K DR S DR=LRFLD
  1.  ...D EDIT^LRAPMRL1
  1.  ...D COMPARE Q:LRQUIT
  1.  ...D AUDIT Q:LRQUIT
  1.  ...D STORE
  1.  .I LRAU,LREDIAG D
  1.  ..S LRDSC="PATHOLOGICAL DIAGNOSIS"
  1.  ..S LRFLD=32.3
  1.  ..D SAVTXT
  1.  ..K DR S DR=LRFLD
  1.  ..D EDIT^LRAPMRL1
  1.  ..D COMPARE
  1.  .I $G(SEX)["F","SPCY"[LRSS D DEL^LRWOMEN
  1.  .I LRQUIT D UNLOCK Q
  1.  .I LREDIAG D UNLOCK Q
  1.  .D:LRESCPT CPTCODE^LRAPMRL1
  1.  .D UNLOCK
  1.  Q
  1. TITLE ;Title
  1.  S (LRQUIT,LRQUIT1)=0
  1.  D CK^LRAP
  1.  I Y=-1 S LRQUIT=1 Q
  1.  W @IOF
  1.  S LRMSG="Modify Released Pathology Reports"
  1.  S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM)
  1.  S LRMSG(1,"F")="!!"
  1.  S LRMSG(2)="",LRMSG(2,"F")="!"
  1.  D EN^DDIOL(.LRMSG) K LRMSG
  1.  Q
  1. NOTICE ;Warn the user and allow an exit
  1.  K LRMSG
  1.  S LRMSG="NOTICE"
  1.  S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM),LRMSG(1,"F")="!!"
  1.  S LRMSG(2)="",LRMSG(2,"F")="!"
  1.  S LRMSG(3)=$C(7)_"This option allows modification of a verified/"
  1.  S LRMSG(3)=LRMSG(3)_"released pathology report."
  1.  S LRMSG(3,"F")="!?3"
  1.  S LRMSG(4)="Continuing with this option will unrelease the report "
  1.  S LRMSG(4)=LRMSG(4)_"and flag the report",LRMSG(4,"F")="!?3"
  1.  S LRMSG(5)="as modified even if the data is unchanged.  It will "
  1.  S LRMSG(5)=LRMSG(5)_"also be queued to the",LRMSG(5,"F")="!?3"
  1.  S LRMSG(6)="final report queue so that it may be verified/released "
  1.  S LRMSG(6)=LRMSG(6)_"again.",LRMSG(6,"F")="!?3"
  1.  D EN^DDIOL(.LRMSG) K LRMSG
  1.  W !!
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
  1.  D ^DIR
  1.  S:Y<1 LRQUIT=1
  1.  Q
  1. WHAT ;What is to be edited
  1.  W !
  1.  K DIR
  1.  ;Don't ask to Edit Diagnosis if initial entry of diagnosis is turned
  1.  ;  off at data entry for SP, CY, EM's
  1.  S LRASK=1,XASK=""
  1.  I 'LRAU D
  1.  .S XASK=$S(LRSS="SP":11.2,LRSS="CY":11.3,1:"")
  1.  .S:XASK="" XASK=$S(LRSS="EM":11.4,1:"")
  1.  .S LRASK=$$GET1^DIQ(69.9,"1,",XASK,"I")
  1.  S:LRASK DIR(0)="S^1:Edit Report;2:Edit Diagnosis"
  1.  S:LRASK DIR("A")="Enter selection",DIR("B")=1
  1.  S:'LRASK DIR(0)="Y",DIR("B")="YES",DIR("A")="Edit Report?"
  1.  D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S LRQUIT=1 Q
  1.  S:Y=0 LRQUIT=1
  1.  Q:LRQUIT=1
  1.  S LREDIAG=Y
  1.  S LREDIAG=$S(LREDIAG=2:1,1:0)
  1.  Q
  1. CPTCHK ;Determine if CPT is activated
  1.  Q:$T(ES^LRCAPES)=""
  1.  ; I $$PATCH^BLRUTIL4("PX*1.0*119") S LRESCPT=$$ES^LRCAPES()       ; IHS/MSC/MKK - LR*5.2*1031
  1.  I $$PATCH^BLRUTIL4("PX*1.0*197") I $T(ES^LRCAPES)'="" S LRESCPT=$$ES^LRCAPES()     ; IHS/MSC/MKK - LR*5.2*1033
  1.  Q
  1. SECTION ;Choose Anatomic Pathology section (AU,SP,CY,EM)
  1.  W !
  1.  D ^LRAP
  1.  I '$D(Y)!('$D(LRSS)) S LRQUIT=1 Q
  1.  S:LRO(68)="EM" LRO(68)="ELECTRON MICROSCOPY"
  1.  S LRAU=0            ; LRAU = 0 - Not Autopsy
  1.  S:LRSS="AU" LRAU=1  ;      = 1 - Autosy
  1.  I LRCAPA D @(LRSS_"^LRAPSWK")
  1.  S LRMSG(1)=LRO(68)_" ("_LRABV_")",LRMSG(1,"F")="!?20"
  1.  S LRMSG(2)="",LRMSG(2,"F")="!"
  1.  D EN^DDIOL(.LRMSG) K LRMSG
  1.  Q
  1. ASK ;Ask etiology,function,procedure,disease,weights,measures
  1.  I LREDIAG D  Q
  1.  .S:'LRAU LREFPD=0
  1.  .S:LRAU LRWM=0
  1.  W !
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="Edit etiology, function, procedure & disease"
  1.  D ^DIR
  1.  I Y="^" S LRQUIT=1 Q
  1.  S LREFPD=$S(+Y:1,1:0)
  1.  I LRAU D
  1.  .W !
  1.  .S DIR(0)="Y",DIR("B")="NO"
  1.  .S DIR("A")="Edit weights and measures"
  1.  .D ^DIR
  1.  .I Y="^" S LRQUIT=1 Q
  1.  .S LRWM=$S(+Y:1,1:0)
  1.  Q
  1. ACCYR ;Determine Accession Year
  1.  D ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
  1.  I LRAD1=-1 S LRQUIT=1 Q
  1.  I LRAD1 S LRAD=$P(LRAD1,U),LRH(0)=$P(LRAD1,U,2)
  1.  Q
  1. ASK2 ;Ask about other fields
  1.  S LRGMDF=0
  1.  K LRDSC
  1.  I LRFLD=1!(LRFLD=1.1) D
  1.  .S:LRFLD=1 LRFLDA=7
  1.  .S:LRFLD=1.1 LRFLDA=4
  1.  .S LRDSC=$S(LRFLD=1:"GROSS",LRFLD=1.1:"MICROSCOPIC",1:"")
  1.  .S LRDSC=LRDSC_" DESCRIPTION"
  1.  S:LRFLD=1.4 LRDSC="DIAGNOSIS",LRFLDA=5
  1.  S:LRFLD=1.3 LRDSC="FROZEN SECTION",LRFLDA=6
  1.  I 'LREDIAG D
  1.  .S DIR(0)="Y",DIR("B")="NO"
  1.  .S DIR("A")="Edit "_LRDSC
  1.  .D ^DIR
  1.  .I Y="^" S LRQUIT=1 Q
  1.  .S LRGMDF=$S(+Y:1,1:0)
  1.  S:LREDIAG LRGMDF=1
  1.  Q
  1. SAVTXT ;Save word processing field text.
  1.  S LRNOTXT=0
  1.  K ^TMP("DIQ1",$J)
  1.  S:'LRAU LRIENS=LRI_","_LRDFN_",",LRFILE=LRSF
  1.  S:LRAU LRIENS=LRDFN_",",LRFILE=63
  1.  Q:LRFLD=""
  1.  S LRTMP=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","^TMP(""DIQ1"",$J)")
  1.  I LRTMP="" D
  1.  .K LRMSG
  1.  .S LRMSG(1)="There is no "_LRDSC_" text to modify."
  1.  .S LRMSG(1,"F")="!!"
  1.  .S LRMSG(2)="Report was released before entering text."
  1.  .S LRMSG(2,"F")="!"
  1.  .D EN^DDIOL(.LRMSG)
  1.  .S LRNOTXT=1
  1.  Q
  1. COMPARE ;Compare report text
  1.  S (LRCHG,LRQUIT,LRCT)=0
  1.  S:'LRAU LRFILE="^LR(LRDFN,LRSS,LRI,LRFLD,"
  1.  S:LRAU LRFILE="^LR(LRDFN,82,"
  1.  I '$D(@(LRFILE_"0)")) D  Q
  1.  .Q:LRNOTXT
  1.  .S LRQUIT=1
  1.  F  S LRCT=$O(@(LRFILE_"LRCT)")) Q:'LRCT  D
  1.  .S LRXTMP=@(LRFILE_"LRCT,0)")
  1.  .I '$D(^TMP("DIQ1",$J,LRCT)) S LRCHG=1 Q
  1.  .S LRYTMP=^TMP("DIQ1",$J,LRCT)
  1.  .I LRXTMP'=LRYTMP S LRCHG=1
  1.  I 'LRCHG D
  1.  .S LRCT=0 F  S LRCT=$O(^TMP("DIQ1",$J,LRCT)) Q:'LRCT  D
  1.  ..I '$D(@(LRFILE_"LRCT,0)")) S LRCHG=1
  1.  I 'LRCHG D  Q
  1.  .D EN^DDIOL("No changes made to "_LRDSC_".","","!!")
  1.  .W !
  1.  .K ^TMP("DIQ1",$J)
  1.  I LRCHG&(LRFLD=1.4!(LRFLD=32.3)) D  ;Indicate that the diagnosis
  1.  .K LRFDA                            ;has been modified.
  1.  .S:'LRAU LRFDA(LRSF,LRIENS,.172)=1
  1.  .;KLL-CORRECT BUG WHERE LRSF IS NULL, REPLACE LRSF WITH 63
  1.  .S:LRAU LRFDA(63,LRIENS,102.2)=1
  1.  .;S:LRAU LRFDA(LRSF,LRIENS,102.2)=1
  1.  .D FILE^DIE("","LRFDA")
  1.  Q
  1. AUDIT ;
  1.  N LRNTIME
  1.  K LRFDA
  1.  D NOW^%DTC S LRNTIME=%
  1.  S LRIENS1="+1,"_LRIENS
  1.  S LRFILE=+$$GET1^DID(LRSF,LRFLDA,"","SPECIFIER")
  1.  I LRFILE="" S LRQUIT=1 Q
  1.  S LRFDA(1,LRFILE,LRIENS1,.01)=LRNTIME
  1.  S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
  1.  D UPDATE^DIE("","LRFDA(1)","LRORIEN")
  1.  Q
  1. STORE ;
  1.  K LRIENS1
  1.  S LRIENS1=LRORIEN(1)_","_LRIENS
  1.  S LRWPROOT="^TMP(""DIQ1"",$J)"
  1.  D WP^DIE(LRFILE,LRIENS1,1,"",LRWPROOT)
  1.  K ^TMP("DIQ1",$J)
  1.  Q
  1. SUPRPT ;Supplementary Report
  1.  K DIR
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="Edit SUPPLEMENTARY REPORTS"
  1.  D ^DIR
  1.  I Y="^" S LRQUIT1=1 Q
  1.  Q:Y<1
  1.  N LRX,LRRLS,LRA,LRFLG,LRNOW
  1.  D GETRPT^LRAPDSR Q:LRQUIT
  1.  S LRRLS=1,LRRLS1=0
  1.  D COPY^LRAPDSR Q:LRQUIT
  1.  D RPT^LRAPDSR Q:LRQUIT
  1.  S Y=LRDA
  1.  D RELEAS2^LRAPDSR
  1.  D COMPARE^LRAPDSR Q:LRQUIT
  1.  D UNRELEAS^LRAPDSR
  1.  D UPDATE^LRAPDSR Q:LRQUIT
  1.  D STORE^LRAPDSR
  1.  Q
  1. UNLOCK ;Unlock the record
  1.  ; D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))  ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
  1.  I $$PATCH^BLRUTIL4("PXRM*1.5*12") D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))  ; IHS/MSC/MKK - LR*5.2*1031
  1.  L -@(LRLOCK)
  1.  Q
  1. END ;Clean-up variables and quit
  1.  K ^TMP("LRAPBR",$J),^TMP("TIUP",$J)
  1.  D CLEAN^DILF
  1.  D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES
  1.  D V^LRU
  1.  Q