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/STAFF - AP SUPPLEMENTARY REPORT ENTRY;Dec 17, 2008
  1.  ;;5.2;LAB SERVICE;**248,259,295,317,350**;Sep 27, 1994;Build 230
  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,LRSRDA
  1.  ;
  1. MAIN ; Main Subroutine
  1.  D RELEAS1
  1.  D GETRPT
  1.  Q:LRQUIT
  1.  D RELEAS2
  1.  Q:LRQUIT
  1.  D:LRRLS COPY
  1.  Q:LRQUIT
  1.  D RPT
  1.  ;
  1.  ; Ask for performing laboratory assignment
  1.  D EDIT^LRRPLU(LRDFN,LRSS,LRI)
  1.  ;
  1.  ; Add supp report to the PRELIMINARY print queue
  1.  D QUESP
  1.  Q:LRQUIT
  1.  D COMPARE
  1.  Q:LRQUIT
  1.  ;
  1.  ; If supp report is already released (LRRLS1) unrelease it 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.  ;
  1.  ;
  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 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 an audit trail.",!
  1.  . S LRRLS=1
  1.  Q
  1.  ;
  1.  ;
  1. GETRPT ; First, select the report
  1.  ;
  1.  N DA,DIC,DO,DIR,DIRUT,DTOUT,DUOUT,LRLAST,LRSFN,LRX,X,Y
  1.  ;
  1.  S (X,Y)=0
  1.  I LRSS'="AU" D
  1.  . F  S X=$O(^LR(LRDFN,LRSS,LRI,1.2,X)) Q:'X  D
  1.  . . S X(0)=^LR(LRDFN,LRSS,LRI,1.2,X,0),Y=Y+1
  1.  . . S DIR("A",Y)=Y_" - "_$$FMTE^XLFDT($P(X(0),"^"),"1M")
  1.  . . S LRSFN=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
  1.  . . I $P(X(0),"^",2)'="" S DIR("A",Y)=DIR("A",Y)_"  Released: "_$$EXTERNAL^DILFD(LRSFN,.02,"",$P(X(0),"^",2))
  1.  . . I $P(X(0),"^",3)'="" S DIR("A",Y)=DIR("A",Y)_"  Report Modified: "_$$EXTERNAL^DILFD(LRSFN,.03,"",$P(X(0),"^",3))
  1.  . . S LRX(Y)=X
  1.  ;
  1.  I LRSS="AU" D
  1.  . F  S X=$O(^LR(LRDFN,84,X)) Q:'X  D
  1.  . . S X(0)=^LR(LRDFN,84,X,0),Y=Y+1
  1.  . . S DIR("A",Y)=Y_" - "_$$FMTE^XLFDT($P(X(0),"^"),"1M")
  1.  . . I $P(X(0),"^",2)'="" S DIR("A",Y)=DIR("A",Y)_"  Released: "_$$EXTERNAL^DILFD(63.324,.02,"",$P(X(0),"^",2))
  1.  . . I $P(X(0),"^",3)'="" S DIR("A",Y)=DIR("A",Y)_"  Report Modified: "_$$EXTERNAL^DILFD(63.324,.03,"",$P(X(0),"^",3))
  1.  . . S LRX(Y)=X
  1.  ;
  1.  S LRLAST=Y+1
  1.  I LRLAST>1 D  Q:LRQUIT
  1.  . S DIR("A",LRLAST)=LRLAST_" - Add a new SUPPLEMENTARY REPORT"
  1.  . S DIR("A")="Select SUPPLEMENTARY REPORT"
  1.  . S DIR("?",1)="Enter a number from 1 to "_LRLAST
  1.  . S DIR("?")="Select the number of the supplementary report to edit"
  1.  . S DIR(0)="NO:1:"_LRLAST_":0"
  1.  . D ^DIR
  1.  . I Y<1 S LRQUIT=1 Q
  1.  ;
  1.  ; Selected existing report
  1.  I LRLAST>1,Y<LRLAST S LRSRDA=LRX(Y) Q
  1.  ;
  1.  ; Adding new report - ask for new date/time
  1.  K DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  I LRLAST=1 W !,"Adding a new SUPPLEMENTARY REPORT"
  1.  S DIR(0)=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="AU":63.324,LRSS="EM":63.207,1:"")_",.01"
  1.  D ^DIR
  1.  I Y<1 S LRQUIT=1 Q
  1.  ;
  1.  K DA,DO,DIC
  1.  I LRSS'="AU" S DIC="^LR(LRDFN,LRSS,LRI,1.2,",DA(1)=LRDFN,DA=LRI
  1.  E  S DIC="^LR(LRDFN,84,",DA=LRDFN
  1.  S DIC(0)="EF",X=+Y,DIC("DR")=".02////0"
  1.  D FILE^DICN
  1.  I Y<1 S LRQUIT=1
  1.  S LRSRDA=+Y
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. RELEAS2 ; Is the supplementary report already released?
  1.  ;
  1.  I LRSS'="AU" S LRX=$G(^LR(LRDFN,LRSS,LRI,1.2,LRSRDA,0))
  1.  E  S LRX=$G(^LR(LRDFN,84,LRSRDA,0))
  1.  S LRRLS2=+$P(LRX,"^",2)
  1.  I LRRLS2 D
  1.  . N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  . S DIR(0)="YO",DIR("B")="NO"
  1.  . S DIR("A",1)=$C(7)
  1.  . S DIR("A",2)="This supplementary report has been released."
  1.  . S DIR("A",3)="Additions/modifications will create an audit trail."
  1.  . S DIR("A")="Sure you want to update this record"
  1.  . D ^DIR
  1.  . I Y=1 S LRRLS1=1
  1.  . E  S LRQUIT=1
  1.  Q
  1.  ;
  1.  ;
  1. COPY ; Make a copy of the current report.
  1.  K ^TMP("DIQ1",$J)
  1.  S LRIENS=LRSRDA_","_$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.  ;
  1.  ;
  1. RPT ;
  1.  N DIE,DA,DR
  1.  ;S DIE=DIC K DIC
  1.  S DIE=$S(LRSS="AU":"^LR(LRDFN,84,",1:"^LR(LRDFN,LRSS,LRI,1.2,")
  1.  S (LRDA,DA)=LRSRDA
  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.  ;
  1.  ;
  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):DILOCKTM
  1.  . I '$T D  Q
  1.  . . S MSG(1)="The preliminary reports queue is in use.",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.  ;
  1.  ;
  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
  1.  . 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.  ;
  1.  ;
  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.  ;
  1.  ;
  1. UPDATE ; File changes
  1.  ; First, store the date of the change and user ID
  1.  D UPDATE^LRPXRM(LRDFN,LRSS,+$G(LRI))
  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.  ;
  1.  ;
  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