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

LRSPRPT.m

Go to the documentation of this file.
  1. LRSPRPT ;DALOI/STAFF - CY/EM/SP PATIENT RPT ; 30 Aug 2016 5:20 PM
  1. ;;5.2;LAB SERVICE;**1,72,248,259,317,350,416,464**;Sep 27, 1994;Build 12
  1. ;
  1. W !!?20,LRO(68)," FINAL PATIENT REPORTS"
  1. K LRSAV,LRAP,LRS(99)
  1. D EN2^LRUA
  1. G END^LRSPRPT1:LRAPX=2,SGL:LRAPX=3,CH:LRAPX=4
  1. GETP ;
  1. D EN1^LRUPS Q:LRAN=-1
  1. G:$D(^LRO(69.2,LRAA,2,LRAN,0)) GETP
  1. D LOCK^DILF("^LRO(69.2,LRAA,2)")
  1. I '$T D G GETP
  1. . N MSG
  1. . S MSG(1)="The final reports queue is in use by another person.",MSG(1,"F")="!!"
  1. . S MSG(2)="You will need to add this accession to the queue later."
  1. . D EN^DDIOL(.MSG)
  1. S ^LRO(69.2,LRAA,2,LRAN,0)=LRDFN_"^"_LRI
  1. S X=^LRO(69.2,LRAA,2,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1)
  1. L -^LRO(69.2,LRAA,2)
  1. G GETP
  1. ;
  1. ;
  1. CH ;
  1. S LRAPX(1)=2 D EN^LRSPRPT2 Q:$G(%)<1
  1. W !!,"Save final report list for reprinting "
  1. S %=2 D YN^LRU S:%=1 LRSAV=1
  1. ; Variable LR("DVD") is used to divide reports displayed in the browser
  1. K LR("DVD")
  1. S $P(LR("DVD"),"|",IOM)=""
  1. DEV ; from LRAPMOD
  1. W !
  1. S %ZIS="Q" D ^%ZIS
  1. I POP W ! D END Q
  1. I $D(IO("Q")) D Q
  1. . N ZTDESC,ZTRTN,ZTSAVE,ZTSK
  1. . S ZTDESC="ANAT PATH FINAL REPORT"
  1. . S ZTSAVE("LR*")="",ZTRTN="QUE^LRSPRPT"
  1. . D ^%ZTLOAD,HOME^%ZIS
  1. . D EN^DDIOL("Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
  1. . D END
  1. ;
  1. QUE ;
  1. U IO
  1. N LRFFF
  1. ; LRSF515=1 means generating an SF515
  1. S:'$D(LRSF515) LRSF515=0
  1. S:'$D(LRFOC) LRFOC=0
  1. S:'$D(LRQUIT) LRQUIT=0
  1. S LRFFF=1 ;Flag to perform final form feed
  1. I LRFOC S LRFFF=0 ;If final office copy, don't perform final form feed
  1. S LR(.21)=+$G(^LRO(69.2,LRAA,.2)),LR("DIWF")="W"
  1. S LRA=$S($D(^LRO(69.2,LRAA,0)):$P(^(0),U,9),1:1) S:LRA="" LRA=1
  1. D L^LRU,S^LRU,L1^LRU,SET^LRUA
  1. ;
  1. PSGL ; Single Report
  1. I $D(LRAP) D G LST
  1. . S LRDFN=$P(LRAP,"^"),LRI=$P(LRAP,"^",2)
  1. . I +$G(LRPTR) D Q
  1. . . D MAIN^LRAPTIUP(LRPTR,0)
  1. . . S LRFFF=0 ;Don't do final form feed. It's done by LRAPTIUP.
  1. . . I LRQUIT S LR("Q")=1 Q
  1. . . K LRAP S LR("F")=1
  1. . . I 'LR("Q"),$D(LR("F")),IOST?1"C".E D CONT
  1. . . Q:LR("Q")
  1. . . I 'LRFOC S LR("Q")=1 Q
  1. . . D FOC
  1. . . I LRQUIT S LR("Q")=1 Q
  1. . . I 'LR("Q"),$D(LR("F")),IOST?1"C".E D CONT
  1. . W:IOST?1"C-".E @IOF
  1. . D EN
  1. . K LRAP
  1. . I 'LR("Q"),$D(LR("F")),IOST?1"C".E D CONT
  1. . Q:LR("Q")
  1. . I 'LRFOC S LR("Q")=1 Q
  1. . W !
  1. . W:IOST?1"P-".E @IOF
  1. . D FOC
  1. . I LRQUIT S LR("Q")=1 Q
  1. . I 'LR("Q"),$D(LR("F")),IOST?1"C".E D CONT
  1. ;
  1. PQUE ;Report from queue
  1. S LRAN=0
  1. F S LRAN=$O(^LRO(69.2,LRAA,2,LRAN)) Q:'LRAN!(LR("Q")) D
  1. . S LRQUIT=0
  1. . I 'LRFOC S LRFFF=1
  1. . K LR("F")
  1. . S X=^LRO(69.2,LRAA,2,LRAN,0),LRDFN=+X,LRI=$P(X,"^",2)
  1. . D TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
  1. . I +$G(LRPTR) D Q
  1. . . D MAIN^LRAPTIUP(LRPTR,0)
  1. . . S LRFFF=0
  1. . . W:IOST["BROWSER"&('LRFOC) !!,LR("DVD")
  1. . . K LRPTR
  1. . . I LRQUIT S LR("Q")=1 Q
  1. . . S LR("F")=1
  1. . . I 'LR("Q"),$D(LR("F")),IOST?1"C-".E D CONT
  1. . . Q:LR("Q")!('LRFOC)
  1. . . D FOC
  1. . . W:IOST["BROWSER" !!,LR("DVD")
  1. . . I LRQUIT S LR("Q")=1 Q
  1. . . I 'LR("Q"),$D(LR("F")),IOST?1"C".E D CONT
  1. . W:IOST?1"C-".E @IOF
  1. . D EN
  1. . W:IOST?1"P-".E @IOF
  1. . W:IOST["BROWSER"&('LRFOC) !!,LR("DVD")
  1. . I 'LR("Q"),$D(LR("F")),IOST?1"C-".E D CONT
  1. . Q:LR("Q")
  1. . Q:'LRFOC
  1. . W !
  1. . D FOC
  1. . W:IOST["BROWSER" !!,LR("DVD")
  1. . I LRQUIT S LR("Q")=1 Q
  1. . I 'LR("Q"),$D(LR("F")),IOST?1"C".E D CONT
  1. S LRFFF=0
  1. ;
  1. LST ;
  1. K LRRMD,LRPMD,LRAP
  1. K:'$D(LRSAV) ^LRO(69.2,LRAA,2)
  1. S ^LRO(69.2,LRAA,2,0)="^69.23A^^0"
  1. K LRSAV,LRV,LRW,LRZ
  1. I IOST?1"P-".E W:LRFFF @IOF
  1. D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1. K %,DIR,DTOUT,DUOUT,DIRUT,X,Y
  1. D END
  1. Q
  1. ;
  1. ;
  1. W ;
  1. W !,LR("%")
  1. Q
  1. ;
  1. ;
  1. F ;
  1. ; N A,DIWF,DIWL,DIWR
  1. D E
  1. S A=0,DIWF=$TR(DIWF,"W","")
  1. F S A=$O(^LR(LRDFN,LRSS,LRI,LRV,A)) Q:'A S X=^LR(LRDFN,LRSS,LRI,LRV,A,0) D:X["|TOP|" TOP D ^DIWP
  1. S A=0
  1. F S A=$O(^UTILITY($J,"W",DIWL,A)) Q:'A D:$Y>(IOSL-11) F^LRAPF,^LRAPF Q:LR("Q") W !,^UTILITY($J,"W",DIWL,A,0)
  1. I $Y<(IOSL-11) W !
  1. K ^UTILITY($J,"W")
  1. Q
  1. ;
  1. ;
  1. E ;
  1. K ^UTILITY($J,"W")
  1. S DIWR=IOM-5,DIWL=5,DIWF=""
  1. ;
  1. ; Set gross description field to value from file #69.2
  1. ;I LRV=1 S DIWF=LR("DIWF")
  1. S DIWF=LR("DIWF")
  1. ;
  1. Q
  1. ;
  1. ;
  1. EN ; from LRSPT
  1. ; Moved to LRSPRPTA due to size limits on routine
  1. D EN^LRSPRPTA
  1. Q
  1. ;
  1. ;
  1. S ;
  1. S Y=+X,X=$P(X,U,2) D D^LRU
  1. W !?3,"Date: ",Y
  1. I $D(LR("R")),'X W " not verified" Q
  1. D:$Y>(IOSL-13) F^LRAPF,^LRAPF Q:LR("Q")
  1. D:$P($G(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,0)),U,4) SUPA
  1. D E S B=0
  1. F LRZ=0:1 S B=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,1,B)) Q:'B!(LR("Q")) D
  1. . D:$Y>(IOSL-14) F^LRAPF,^LRAPF Q:LR("Q")
  1. . ;S DIWF="W" ;LR*5.2*464
  1. . S DIWF="WN" ;LR*5.2*464
  1. . S X=^LR(LRDFN,LRSS,LRI,1.2,LRV,1,B,0) D ^DIWP Q:LR("Q")
  1. Q:LR("Q")
  1. D:LRZ ^DIWW
  1. Q
  1. ;
  1. ;
  1. SGL ; Print Single Report
  1. N LRPTR
  1. S LRAPX(1)=""
  1. D EN1^LRUPS Q:LRAN=-1
  1. I '$P(^LR(LRDFN,LRSS,LRI,0),"^",11) D G SGL
  1. . W $C(7)," Sorry, report not verified.",!
  1. D TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
  1. S LRAP=LRDFN_"^"_LRI,LRSAV=1
  1. D EN2^LRUA
  1. G DEV
  1. ;
  1. ;
  1. A ;
  1. S A=0 F S A=$O(^LR(LRDFN,LRSS,LRI,LRV,A)) Q:'A!(LR("Q")) D
  1. . D:$Y>(IOSL-13) F^LRAPF,^LRAPF Q:LR("Q")
  1. . W !,$P(^LR(LRDFN,LRSS,LRI,LRV,A,0),"^")
  1. Q
  1. ;
  1. ;
  1. TOP ;
  1. S Z=$P(X,"|TOP|",1)_$P(X,"|TOP|",2) D F^LRAPF,^LRAPF S X=Z
  1. Q
  1. ;
  1. ;
  1. SUPA ; Print supplementary report audit information
  1. W !?14,"*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
  1. W !,"(Added/Last modified: "
  1. S (A,B)=0 F S A=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,A)) Q:'A!(LR("Q")) D
  1. . S B=A
  1. Q:LR("Q")
  1. Q:'$D(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,B,0))
  1. S A=^(0),Y=+A,LRSGN=" typed by ",A=$P(A,"^",2)
  1. I $P(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,B,0),"^",3) D
  1. . S A=^(0),LRSGN=" signed by ",A2=$P(A,"^",3),Y=$P(A,"^",4)
  1. . S A=A2
  1. S A=$S($D(^VA(200,A,0)):$P(^(0),"^"),1:A)
  1. ; If supp rpt is released, display 'signed by' instead of 'typed by'
  1. D D^LRU W Y,LRSGN,A,")"
  1. ; If RELEASE SUPP REPORT MODIFIED set to 1, display "NOT VERIFIED"
  1. I $P(^LR(LRDFN,LRSS,LRI,1.2,LRV,0),"^",3) W !,?25,"**-* NOT VERIFIED *-**"
  1. D:$D(LRQ(9)) SUPM
  1. Q
  1. ;
  1. ;
  1. SUPM ; Print previous versions of supplementary reports
  1. ; This is used by menu option 'Print path modifications [LRAPMOD]'
  1. ;
  1. S A=0 F S A=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,A)) Q:'A!(LR("Q")) D
  1. . S LRT=^LR(LRDFN,LRSS,LRI,1.2,LRV,2,A,0)
  1. . D:$Y>(IOSL-13) F^LRAPF,^LRAPF Q:LR("Q")
  1. . S Y=+LRT,Y2=" modified: ",X=$P(LRT,"^",2),LRSGN=" typed by "
  1. . ; If supp rpt is released, display 'signed by' instead of 'typed by'
  1. . I $P(LRT,"^",3) S LRSGN=" signed by ",X=$P(LRT,"^",3),Y=$P(LRT,"^",4),Y2=" released: "
  1. . S X=$S($D(^VA(200,X,0)):$P(^(0),"^"),1:X)
  1. . D D^LRU W !,"Date ",Y2,Y,LRSGN,X
  1. . K ^UTILITY($J)
  1. . S DIWR=IOM-5,DIWL=5,DIWF="W"
  1. . S B=0
  1. . F LRZ=0:1 S B=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,A,1,B)) Q:'B!(LR("Q")) D
  1. . . S LRT=^LR(LRDFN,LRSS,LRI,1.2,LRV,2,A,1,B,0)
  1. . . D:$Y>(IOSL-13) F^LRAPF,^LRAPF Q:LR("Q")
  1. . . S X=LRT D ^DIWP
  1. . Q:LR("Q") D:LRZ ^DIWW
  1. Q:LR("Q")
  1. W !?13,"==========Text below appears on final report=========="
  1. Q
  1. ;
  1. ;
  1. CONT ;
  1. K DIR S DIR(0)="E"
  1. D ^DIR W !
  1. S:$D(DTOUT)!(X[U) LR("Q")=1
  1. Q
  1. ;
  1. ;
  1. FOC ; Print final office copy page (SNOMEDS)
  1. N LRADC,LRCTR
  1. I '$D(LRAP) D
  1. . D:LRSS'="AU" ^LRUA
  1. . I LRSS="AU" S X=^LR(LRDFN,0) D ^LRUP
  1. I LRSS="AU" D
  1. . S LRADC=$E($P(^LR(LRDFN,LRSS),"^"),1,3)_"0000"
  1. . S:+$G(LRDPF)=2 LRDEM("DTH")=$P(VADM(6),"^",2)
  1. . ; Get DATE DIED from Referral File for Referral Patients
  1. . S:+$G(LRDPF)'=2 LRDEM("DTH")=$$GET1^DIQ(67,DFN_",",.351)
  1. . S LRDEM("AUDT")=$$GET1^DIQ(63,LRDFN_",",11)
  1. . S LRDEM("AUTYP")=$$GET1^DIQ(63,LRDFN_",",13.7)
  1. . S LRDEM("PRO")=$$GET1^DIQ(63,LRDFN_",",13.5)
  1. I LRSS'="AU" D
  1. . S LRADC=$E($P(^LR(LRDFN,LRSS,LRI,0),"^",10),1,3)_"0000"
  1. . S LRDEM("PRO")=LRMD
  1. S LRDEM("PNM")=LRP,LRDEM("SSN")=SSN
  1. S LRDEM("SEX")=SEX,LRDEM("AGE")=AGE,LRDEM("DOB")=DOB
  1. D INIT^LRAPSNMD(LRDFN,LRSS,$G(LRI),LRSF,LRAA,LRAN,LRADC,.LRDEM,0)
  1. Q
  1. ;
  1. ;
  1. END ;
  1. D V^LRU
  1. K LRSF515
  1. Q