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

LRAPDSR.m

Go to the documentation of this file. 
  1. LRAPDSR ;DALOI/WTY/KLL - AP SUPPLEMENTARY REPORT ENTRY;12/05/00
  1.  ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
  1.  ;
  1.  ;;VA LR Patche(s): 248,259,295,317
  1.  ;
  1.  N LRYTMP,LRWPROOT,LRRLS,LRRLS1,LRRLS2,LRX,LRIENS,LRFILE1,LRFILE,LRA
  1.  N LRIENS1,LRXTMP,LRFDA,LRNOW,LRIENS2,LRFIELD,LRORIEN,LRFLG,LRDA,LRQUIT
  1.  ;
  1. MAIN ;Main Subroutine
  1.  D RELEAS1
  1.  D GETRPT
  1.  Q:LRQUIT
  1.  D RELEAS2
  1.  D:LRRLS COPY
  1.  Q:LRQUIT
  1.  D RPT
  1.  ;Add supp report to the PRELIMINARY print queue
  1.  D QUESP
  1.  Q:LRQUIT
  1.  D COMPARE
  1.  Q:LRQUIT
  1.  ;If supp report is already released (LRRLS1), unrelease it,
  1.  ;   but only if the E-Sign Switch is ON (LRESSW)
  1.  N LRESSW
  1.  D GETDATA^LRAPESON(.LRESSW)
  1.  I LRRLS1,LRESSW D UNRELEAS
  1.  D UPDATE
  1.  Q:LRQUIT
  1.  D STORE
  1.  Q
  1. RELEAS1 ;Is the ENTIRE report already released?
  1.  S (LRRLS,LRRLS1,LRQUIT)=0
  1.  I LRSS="AU" D  Q
  1.  .S LRX=$P($G(^LR(LRDFN,LRSS)),"^",15)
  1.  .Q:'LRX         ;Report has not been released so no audit will occur.
  1.  .W $C(7),!!,"This AUTOPSY has been released.  Supplementary report "
  1.  .W "additions/modifications"
  1.  .W !,"will create an audit trail.",!
  1.  .S LRRLS=1    ;Report has been released so auditing will occur.
  1.  S LRX=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11)
  1.  ;
  1.  I LRX D
  1.  .W $C(7),!!,"This "_$G(LRAA(1))_" report has been released."
  1.  .W !,"Supplementary report additions/modifications will create"
  1.  .W " an audit trail.",!
  1.  .S LRRLS=1
  1.  Q
  1. GETRPT ;First, select the report 
  1.  S DIC(0)="QAEZL",DLAYGO=63
  1.  S DIC("A")="Select SUPPLEMENTARY REPORT DATE: "
  1.  S DIC=$S(LRSS="AU":"^LR(LRDFN,84,",1:"^LR(LRDFN,LRSS,LRI,1.2,")
  1.  S DIC("P")=$S(LRSS="AU":"63,32.4,0",1:"LRSF,1.2,0")
  1.  S DIC("P")=$P(@("^DD("_DIC("P")_")"),"^",2)
  1.  S DIC("B")="" S LRX=0 F  S LRX=$O(@(DIC_"LRX)")) Q:'LRX  D
  1.  .S DIC("B")=+(@(DIC_"LRX,0)"))
  1.  D ^DIC K DLAYGO
  1.  S:Y=-1 LRQUIT=1
  1.  Q
  1. RELEAS2 ;Is the supplementary report already released?
  1.  S LRRLS2=0
  1.  S:LRSS'="AU" LRX=$G(^LR(LRDFN,LRSS,LRI,1.2,+Y,0))
  1.  S:LRSS="AU" LRX=$G(^LR(LRDFN,84,+Y,0))
  1.  S LRRLS2=+$P(LRX,"^",2)
  1.  I LRRLS2 D
  1.  .W $C(7),!!,"This supplementary report has been released.  Additions/"
  1.  .W "modifications",!,"will create an audit trail.",!
  1.  .S LRRLS1=1
  1.  Q
  1. COPY ;Make a copy of the current report.
  1.  K ^TMP("DIQ1",$J)
  1.  S LRIENS=+Y_","_$S(LRSS'="AU":LRI_",",1:"")_LRDFN_","
  1.  S LRFILE1=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
  1.  S:LRFILE1="" LRFILE1=$S(LRSS="AU":63.324,1:"")
  1.  I LRFILE1="" S LRQUIT=1 Q
  1.  D GETS^DIQ(LRFILE1,LRIENS,"**","Z","^TMP(""DIQ1"",$J)")
  1.  Q
  1. RPT ;
  1.  N DIE,DA,DR
  1.  S DIE=DIC K DIC
  1.  S (LRDA,DA)=+Y
  1.  S:LRSS="AU" DA(1)=LRDFN
  1.  S:LRSS'="AU" DA(1)=LRI,DA(2)=LRDFN
  1.  S DR=".01;1" D ^DIE
  1.  I 'LRRLS S LRQUIT=1
  1.  Q
  1. QUESP ;Update the preliminary report print queue
  1.  N LRIENS
  1.  I '$D(^LRO(69.2,LRAA,1,LRAN,0)) D
  1.  .K LRFDA
  1.  .L +^LRO(69.2,LRAA,1):5 I '$T D  Q
  1.  ..S MSG(1)="The preliminary reports queue is in use.  "
  1.  ..S MSG(1,"F")="!!"
  1.  ..S MSG(2)="You will need to add this accession to the queue later."
  1.  ..D EN^DDIOL(.MSG) K MSG
  1.  .S LRIENS="+1,"_LRAA_","
  1.  .S LRFDA(69.21,LRIENS,.01)=LRDFN
  1.  .S LRFDA(69.21,LRIENS,1)=LRI
  1.  .S LRFDA(69.21,LRIENS,2)=LRH(0)
  1.  .S LRORIEN(1)=LRAN
  1.  .D UPDATE^DIE("","LRFDA","LRORIEN")
  1.  .L -^LRO(69.2,LRAA,1)
  1.  Q
  1. COMPARE ;Compare reports
  1.  I '$D(^TMP("DIQ1",$J)) S LRQUIT=1 Q
  1.  S:LRSS'="AU" LRFILE="^LR(LRDFN,LRSS,LRI,1.2,LRDA,1,"
  1.  S:LRSS="AU" LRFILE="^LR(LRDFN,84,LRDA,1,"
  1.  I '$D(@(LRFILE_"0)")) D  Q
  1.  .D:LRRLS1 UNRELEAS
  1.  .S LRQUIT=1
  1.  S LRA=0,LRFLG=1
  1.  F  S LRA=$O(@(LRFILE_"LRA)")) Q:'LRA  D
  1.  .S LRXTMP=@(LRFILE_"LRA,0)")
  1.  .S:'$D(^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA,0)) LRFLG=0
  1.  .Q:'LRFLG
  1.  .S LRYTMP=^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA,0)
  1.  .I LRXTMP'=LRYTMP S LRFLG=0
  1.  I LRFLG D
  1.  .S LRA=0 F  S LRA=$O(^TMP("DIQ1",$J,LRFILE1,LRIENS,1,LRA)) Q:'LRA  D
  1.  ..I '$D(@(LRFILE_"LRA,0)")) S LRFLG=0
  1.  I LRFLG D
  1.  .W $C(7),!!,"No changes were made to the supplementary report."
  1.  .K ^TMP("DIQ1",$J)
  1.  .S LRQUIT=1
  1.  Q
  1. UNRELEAS ;Unrelease the supplementary report.
  1.  K LRFDA
  1.  S LRFDA(1,LRFILE1,LRIENS,.02)="@"
  1.  D UPDATE^DIE("","LRFDA(1)")
  1.  Q
  1. UPDATE ;File changes
  1.  ;First, store the date of the change and user ID
  1.  ; D UPDATE^LRPXRM(LRDFN,LRSS,+$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,LRSS,+$G(LRI))     ; IHS/MSC/MKK - LR*5.2*1031
  1.  K LRFDA
  1.  S X="NOW",%DT="T" D ^%DT S LRNOW=Y
  1.  S LRIENS1="+1,"_LRIENS
  1.  S LRFILE=$S(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
  1.  S:LRFILE="" LRFILE=$S(LRSS="AU":63.3242,1:"")
  1.  I LRFILE="" S LRQUIT=1 Q
  1.  S LRFDA(1,LRFILE,LRIENS1,.01)=LRNOW
  1.  S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ,LRFIELD=1
  1.  D UPDATE^DIE("","LRFDA(1)","LRORIEN")
  1.  ;If E-Sign switch OFF,set 3rd piece .03 SUPP REPORT MODIFIED to 1
  1.  ;  to flag the supp report so it can be released via RS
  1.  I 'LRESSW D
  1.  .S:LRSS'="AU" $P(^LR(LRDFN,LRSS,LRI,1.2,LRDA,0),"^",3)=1
  1.  .S:LRSS="AU" $P(^LR(LRDFN,84,LRDA,0),"^",3)=1
  1.  Q
  1. STORE ;Second, store the original report
  1.  S LRIENS2=LRORIEN(1)_","_LRIENS
  1.  S LRWPROOT="^TMP(""DIQ1"",$J,LRFILE1,LRIENS,1)"
  1.  D WP^DIE(LRFILE,LRIENS2,LRFIELD,"",LRWPROOT)
  1.  K ^TMP("DIQ1",$J)
  1.  Q