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