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

LRAPR.m

Go to the documentation of this file.
  1. LRAPR ;DALOI/STAFF - ANAT RELEASE REPORTS ;12/09/11 10:20
  1. ;;5.2;LAB SERVICE;**72,248,259,317,365,350,490**;Sep 27, 1994;Build 2
  1. ;
  1. N LRESSW,LRX,%,X,Y
  1. D SWITCH
  1. I +LRESSW D Q
  1. . D ^LRAPRES
  1. . D END
  1. W !!?27,"Release Pathology Reports",!!
  1. D A
  1. I '$D(LRSS) D END Q
  1. I LRCAPA D G:'$D(X) END
  1. . S X=$S(LRSS="CY":"CYTOLOGY REPORTING",LRSS="SP":"SURGICAL PATH REPORTING",1:"")
  1. . D:X]"" X^LRUWK
  1. I LRSS="AU" D B Q
  1. ;
  1. S LRSOP="Z"
  1. S DR="S LRX=^LR(LRDFN,LRSS,LRI,0),LRZ=$P(LRX,U,3),LRZ(1)=$P(LRX,U,13),"
  1. S DR=DR_"LRZ(2)=$P(LRX,U,11),LRZ(3)=$P(LRX,U,2);"
  1. S DR=DR_"I 'LRZ W $C(7),!,""No date report completed. "
  1. S DR=DR_"Cannot release."" S Y=0;"
  1. S DR=DR_"I 'LRZ(2) D NMPATH^LRAPR;"
  1. S DR=DR_"I LRZ(2) D RINFO^LRAPR S Y=0;"
  1. ;
  1. ; Perform supp edit regardless if date rept released since supp rpt is added to released report
  1. S DR=DR_"D SUPCHK^LRAPR;"
  1. S DR=DR_"S DIR(0)=""YA"",DIR(""A"")=""Release report? """
  1. S DR=DR_",DIR(""B"")=""NO"" D ^DIR K:Y Y S:$D(Y) Y=0;"
  1. S DR=DR_".11////^S X=$$NOW^XLFDT;.13////^S X=DUZ;"
  1. S DR=DR_"S LRELSD=1 W !!,""Report released..."""
  1. D ^LRAPDA
  1. D END
  1. Q
  1. ;
  1. ;
  1. B ; Autopsy
  1. S LRSOP="Z"
  1. S DR="S LRX=$G(^LR(LRDFN,""AU"")) I LRX="""" S Y=0;"
  1. S DR=DR_"S LRZ=$P(LRX,U,3),LRZ(1)=$P(LRX,U,16),LRZ(2)=$P(LRX,U,15),"
  1. ;
  1. ; KLL-LRZ(3)=SR PATHOLOGIST,LRZ(4)=PROVISIONAL DATE
  1. S DR=DR_"LRZ(3)=$P(LRX,U,10),LRZ(4)=$P(LRX,U,17);"
  1. ;
  1. ; KLL-PROVISIONAL OR DATE REPORT COMPLETED IS REQUIRED
  1. S DR=DR_"I 'LRZ(4),'LRZ W $C(7),!,""Provisional date or date report completed required. "
  1. S DR=DR_"Cannot release."" S Y=0;"
  1. S DR=DR_"I 'LRZ(2) D NMPATH^LRAPR;"
  1. S DR=DR_"I LRZ(2) D RINFO^LRAPR S:LRZ Y=0;"
  1. ; Perform supp edit regardless if date rept released since supp rpt is added to released report
  1. S DR=DR_"D SUPCHK^LRAPR;"
  1. S DR=DR_"D RELEASE^LRAPR;"
  1. S DR=DR_"S LRDTE=$$NOW^XLFDT;"
  1. S DR=DR_"14.7////^S X=$S(LRZ(2):""@"",1:LRDTE);"
  1. S DR=DR_"14.8////^S X=$S(LRZ(2):""@"",1:DUZ);"
  1. S DR=DR_"S:'LRZ(2) LRELSD=1 "
  1. S DR=DR_"W !!,""Report "" W:LRZ(2) ""un"" W ""released..."";K LRDTE"
  1. D ^LRAPDA
  1. D END
  1. Q
  1. ;
  1. ;
  1. EN ; Supplementary Report Entry Point
  1. N LRESSW
  1. D SWITCH
  1. W !!?20,"Release Supplementary Pathology Reports",!
  1. ;D A
  1. ; Section prompt replaces the line above
  1. S LRQUIT=0,LRDATA=0
  1. D SECTION^LRAPRES
  1. I '$D(LRSS) D END Q
  1. ; Verify User ID has access to release supp. reports
  1. S LREND=0
  1. I LRESSW D CLSSCHK^LRAPRES1(DUZ,.LREND)
  1. Q:LREND
  1. ;
  1. N DIR,DIRUT,Y
  1. W !!
  1. S DIR(0)="Y",DIR("A")="Data entry for "_LRH(0)_" "
  1. S DIR("B")="Yes"
  1. D ^DIR K DIR
  1. G:$G(DIRUT) END
  1. I Y=0 D G:Y<1 END
  1. . N DIR
  1. . S DIR(0)="D0^:DT:E"
  1. . D ^DIR
  1. . Q:Y<1
  1. . S LRAD=$E(Y,1,3)_"0000",LRH(0)=$E(Y,1,3)+1700
  1. ;
  1. I '$D(^LRO(68,LRAA,1,LRAD,0)) D Q
  1. . W $C(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!!
  1. ;
  1. W K X,Y,LR("CK")
  1. D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
  1. I LRDATA=-1!('$G(LRSEL))!('$D(LRI)) S LREND=1 G END
  1. S LRIDT=LRI
  1. I LRSEL=3 D DIE
  1. D REST
  1. G W
  1. ;
  1. ;
  1. REST W " for ",LRH(0)
  1. I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D Q
  1. . W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)
  1. . W " not in ACCESSION file",!!
  1. S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X,LRODT=$P(X,"^",4),LRSN=$P(X,"^",5)
  1. Q:'$D(^LR(LRDFN,0)) S X=^(0) D ^LRUP
  1. ;W !,LRP," ID: ",SSN
  1. ;I LRSS'="AU" D
  1. ;.S LRI=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5)
  1. ;.W !,"Specimen(s):"
  1. ;.S X=0 F S X=$O(^LR(LRDFN,LRSS,LRI,.1,X)) Q:'X D
  1. ;..I $D(^LR(LRDFN,LRSS,LRI,.1,X,0)),$L(^(0)) W !,^(0)
  1. ;
  1. ;
  1. DIE ; Define default supplementary report
  1. N LRFILE,LRIENS,LRIENS1,LRX,LRRLS,LRFDA,LRLKFL,LRDA,LRQUIT,LRNOSP
  1. N LRMSG,LRSRFL,LRFDA2,LRSRMD,LRRLM
  1. S DIC("B")="",LRNOSP=0
  1. I LRSS'="AU" D
  1. . S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
  1. . S LRIENS1=LRI_","_LRDFN_","
  1. . I '+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4) S LRNOSP=1 Q
  1. . S LRX=0 F S LRX=$O(^LR(LRDFN,LRSS,LRI,1.2,LRX)) Q:'LRX D
  1. . . S LRIENS=LRX_","_LRIENS1
  1. . . S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
  1. . . ; LRSRMD-set to 1 if supp rpt modified and requires release
  1. . . S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
  1. . . Q:LRSRFL&('LRSRMD)
  1. . . S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
  1. I LRSS="AU" D
  1. . S LRFILE=63.324,LRIENS1=LRDFN_","
  1. . I '+$P($G(^LR(LRDFN,84,0)),"^",4) S LRNOSP=1 Q
  1. . S LRX=0 F S LRX=$O(^LR(LRDFN,84,LRX)) Q:'LRX D
  1. . . S LRIENS=LRX_","_LRIENS1
  1. . . S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
  1. . . ; LRSRMD-set to 1 if supp rpt modified and requires release
  1. . . S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
  1. . . Q:LRSRFL&('LRSRMD)
  1. . . S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
  1. I LRNOSP D Q
  1. . K LRMSG
  1. . S LRMSG=$C(7)_"No supplementary reports exist for this accession."
  1. . D EN^DDIOL(LRMSG,"","!!")
  1. I '$G(DIC("B")) D Q
  1. . K LRMSG
  1. . S LRMSG=$C(7)_"All supplementary reports have been released."
  1. . D EN^DDIOL(LRMSG,"","!!")
  1. ;
  1. DIE1 ;
  1. S (LRQUIT,LRRLM)=0
  1. F D Q:LRQUIT
  1. . W !
  1. . N DIC,DIR,DIRUT,DIROUT,DTOUT,X,Y
  1. . S:LRSS="AU" (LRLKFL,DIC)="^LR(LRDFN,84,"
  1. . S:LRSS'="AU" (LRLKFL,DIC)="^LR(LRDFN,LRSS,LRI,1.2,"
  1. . S DIC("A")="Select SUPPLEMENTARY REPORT DATE: "
  1. . S DIC(0)="AEQM"
  1. . D ^DIC K DIC
  1. . I Y<1 S LRQUIT=1 Q
  1. . S LRDA=+Y
  1. . S LRIENS=LRDA_","_LRIENS1
  1. . S LRRLS=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
  1. . ; If E-Sign OFF, must check LRRLM. LRRLM=1 if supp rpt has been modified and requires release
  1. . S LRRLM=+$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
  1. . I LRESSW,LRRLS D Q
  1. . . W !!,"This supplementary report has already been released.",!
  1. . I 'LRESSW,LRRLS D Q:'LRRLM
  1. . . I 'LRRLM W !!,"This supplementary report has already been released.",!
  1. . W !
  1. . I LRESSW D Q
  1. . . N DIR,DIRUT,DIROUT,DTOUT,X,Y
  1. . . D ESIG Q:LRQUIT
  1. . . D UPDATE
  1. . S DIR("A")="Release supplementary report",DIR(0)="Y",DIR("B")="NO"
  1. . D ^DIR K DIR
  1. . I $D(DIRUT) S LRQUIT=1 Q
  1. . I Y'=1 Q
  1. . D UPDATE
  1. . ; If E-sign switch OFF and orig report released, must verify all supp reports released before release main report.
  1. . I LRCKREL,'LRESSW D CHKSUP^LRAPR1
  1. Q
  1. ;
  1. ;
  1. A D ^LRAP G:'$D(Y) END
  1. Q
  1. ;
  1. ;
  1. C ;
  1. S LRDICS="SPCYEM" D ^LRAP
  1. G:'$D(Y) END
  1. Q
  1. ;
  1. ;
  1. S ; from LRAPDA
  1. S LRK=$P(^LR(LRDFN,LRSS,LRI,0),"^",11) Q:'LRK S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) ^(0)="^68.04PA^^"
  1. Q:$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0))
  1. S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)=LRT_"^50^^"_DUZ_"^"_LRK
  1. S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),^(0)=$P(X,"^",1,2)_"^"_LRT_"^"_($P(X,"^",4)+1)
  1. S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)) ^(0)="^68.14P^^"
  1. S C=0 F S C=$O(LRT(C)) Q:'C D CAP
  1. S ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)=""
  1. Q
  1. ;
  1. ;
  1. CAP ; Store workload
  1. S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0)=C_"^1^0^0^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA
  1. S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+1)
  1. Q
  1. ;
  1. ;
  1. SWITCH ; Check to see if electronic signature is enabled
  1. D GETDATA^LRAPESON(.LRESSW)
  1. Q
  1. ;
  1. ;
  1. ESIG ; Prompt for electronic signature
  1. S LRQUIT=0
  1. D SIG^XUSESIG
  1. I X1="" D
  1. . W " SIGNATURE NOT VERIFIED"
  1. . S LRQUIT=1
  1. Q
  1. ;
  1. ;
  1. UPDATE ;
  1. S LRLKFL=LRLKFL_LRDA_",0)"
  1. L +@(LRLKFL):DILOCKTM I '$T D Q
  1. . S LRMSG="This record is locked by another user. Please wait and try again."
  1. . D EN^DDIOL(LRMSG,"","!!")
  1. S LRFDA(LRFILE,LRIENS,.02)=1
  1. S LRFDA2(LRFILE,LRIENS,.02)="@" ;Set but don't file unless unrel needed
  1. ;
  1. ; File signer ID and Date/time of released supp report
  1. D CKSIGNR^LRAPR1
  1. D FILE^DIE("","LRFDA")
  1. W "...Released"
  1. L -@(LRLKFL)
  1. ;
  1. I LRSS="AU" S LRA=^LR(LRDFN,"AU"),LRAC=$$GET1^DIQ(63,LRDFN_",",14,"I"),LRI=$P(LRA,U)
  1. ;
  1. I LRSS'="AU" S LRA=^LR(LRDFN,LRSS,LRI,0),LRAC=$$GET1^DIQ(LRSF,LRIENS,.06,"I")
  1. ;
  1. D MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC)
  1. ;
  1. ; If all supp reports released, and E-Sign switch is ON, proceed to release main report
  1. S LRCKREL=0
  1. S:LRSS'="AU" LRCKREL=$P(^LR(LRDFN,LRSS,LRI,0),"^",11)
  1. S:LRSS="AU" LRCKREL=$P(^LR(LRDFN,LRSS),"^",15)
  1. ;
  1. I LRCKREL,LRESSW D RELMN Q
  1. ;
  1. ; Check and send LEDI report back to submitting (collecting) site.
  1. ; If RELMN called above then LEDI checked performed during that call, calls RELEASE^LRAPRES.
  1. I LRSS'="AU" D LEDI^LRVR0
  1. ;
  1. Q
  1. ;
  1. ;
  1. SUPCHK ; Check for unreleased supplementary reports
  1. N LRSR,LRSR1,LRSR2
  1. S LRSR=0,LRSR1=1
  1. I LRSS'="AU" D
  1. . Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
  1. . F S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1) D
  1. . . S LRSR1=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U,2)
  1. . . I 'LRSR1 D
  1. . . . S Y=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U)
  1. . . . S LRSR2=$$FMTE^XLFDT(Y,1)
  1. I LRSS="AU" D
  1. . Q:'+$P($G(^LR(LRDFN,84,0)),U,4)
  1. . F S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1) D
  1. . . S LRSR1=+$P(^LR(LRDFN,84,LRSR,0),U,2)
  1. . . I 'LRSR1 D
  1. . . . S Y=+$P(^LR(LRDFN,84,LRSR,0),U)
  1. . . . S LRSR2=$$FMTE^XLFDT(Y,1)
  1. I 'LRSR1 D
  1. . W $C(7),!,"Supplementary report "_LRSR2_" has not been released. "
  1. . W "Cannot release."
  1. . S Y=0
  1. Q
  1. ;
  1. ;
  1. RINFO ; Display release information
  1. W $C(7),!,"Report "
  1. W:LRZ(2)=1 "has already been "
  1. W "released "
  1. W:LRZ(2)>1 $$FMTE^XLFDT(LRZ(2),1)
  1. W:LRZ(1)'="" " by "_$P($G(^VA(200,LRZ(1),0)),U)
  1. Q
  1. ;
  1. ;
  1. NMPATH ; Check for missing pathologist name
  1. I 'LRZ(3) D
  1. . W $C(7),!,"Pathologist name missing. Cannot release."
  1. . S Y=0
  1. Q
  1. ;
  1. ;
  1. RELEASE ; Prompt for release/unrelease
  1. N DIR
  1. W ! S DIR(0)="YA",DIR("B")="NO"
  1. S:LRZ(2) DIR("A")="Unrelease report? "
  1. S:'LRZ(2) DIR("A")="Release report? "
  1. D ^DIR
  1. K:Y Y
  1. I $D(Y) S Y=0
  1. Q
  1. ;
  1. ;
  1. RELMN ; Allow release of main report as long as all supp reports are released, and signer is same person for main and supp report(s)
  1. ; Make sure all supp reports signed out
  1. S LRQT=0
  1. D RELCHK^LRAPR1
  1. Q:LRQT
  1. ;
  1. ; Continue with electronic signature and storage in TIU
  1. S LRAU=$S(LRSS="AU":1,1:0)
  1. I 'LRAU D
  1. . S LRPAT=+$$GET1^DIQ(LRSF,LRIENS1,.02,"I")
  1. . S LRZ=$$GET1^DIQ(LRSF,LRIENS1,.03,"I")
  1. . S LRZ(1)=$$GET1^DIQ(LRSF,LRIENS1,.13,"I")
  1. . S LRZ(1.1)=$$GET1^DIQ(LRSF,LRIENS1,.13)
  1. . S LRZ(2)=$$GET1^DIQ(LRSF,LRIENS1,.11,"I")
  1. I LRAU D
  1. . S LRPAT=+$$GET1^DIQ(63,LRDFN_",",13.6,"I")
  1. . S LRZ=$$GET1^DIQ(63,LRDFN_",",13,"I")
  1. . S LRZ(1)=$$GET1^DIQ(63,LRDFN_",",14.8,"I")
  1. . S LRZ(1.1)=$$GET1^DIQ(63,LRDFN_",",14.8)
  1. . S LRZ(2)=$$GET1^DIQ(63,LRDFN_",",14.7,"I")
  1. . S LRI=""
  1. W !!,?25,"*** Main Report Release ***",!
  1. S LRNTIME=$$NOW^XLFDT
  1. D TIUPREP^LRAPRES
  1. D STORE^LRAPRES
  1. I LRQUIT D FILE^DIE("","LRFDA2") Q
  1. D UNRLSE^LRAPR1
  1. D RELEASE^LRAPRES
  1. I LRQUIT D FILE^DIE("","LRFDA2") Q
  1. D OERR^LR7OB63D
  1. S LRQUIT=1
  1. Q
  1. ;
  1. ;
  1. END ;
  1. D V^LRU
  1. Q