309 lines
8.9 KiB
Mathematica
309 lines
8.9 KiB
Mathematica
LRAPRES ;DALOI/WTY/KLL- AP ESIG RELEASE REPORT;10/30/01
|
|
;;5.2;LAB SERVICE;**259,295,317**;Sep 27, 1994
|
|
;
|
|
;Reference to NEW^TIUPNAPI supported by IA #1911
|
|
MAIN ;
|
|
N LRMSG,LRDEM,LREND,LRQUIT,LRNTIME,LRPRCLSS,LRVCDE,LRMTCH
|
|
N LRPCEXP,LRESCPT,LRPCSTR
|
|
S LRESCPT=0
|
|
D TITLE
|
|
I LRQUIT D END Q
|
|
D CPTCHK
|
|
F D Q:LRQUIT
|
|
.S LRQUIT=0
|
|
.D MENU
|
|
.Q:LRQUIT
|
|
.D SECTION
|
|
.Q:LRQUIT
|
|
.S LREND=0
|
|
.I LRSEL="E" S LREND=0 D CLSSCHK^LRAPRES1(DUZ,.LREND)
|
|
.Q:LREND
|
|
.D ACCYR
|
|
.Q:LRQUIT
|
|
.D ACCPN
|
|
D END
|
|
Q
|
|
ACCPN ;Prompt for accesion number or patient name
|
|
F D Q:LREND
|
|
.S (LRQUIT,LREND)=0
|
|
.D CPTCHK
|
|
.D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
|
|
.Q:'LRDATA
|
|
.I LRDATA=-1 S LREND=1 Q
|
|
.S LRDFN=LRDATA,LRI=LRDATA(1)
|
|
.S LRIENS=LRI_","_LRDFN_","
|
|
.I LRSEL="E" D Q:LRQUIT
|
|
..D RELCHK
|
|
..Q:LRQUIT
|
|
..D:'LRZ(2) BROWSE
|
|
..D ESIG
|
|
..Q:LRQUIT
|
|
..D NOW^%DTC S LRNTIME=%
|
|
..I 'LRZ(2) D TIUPREP,STORE
|
|
..Q:LRQUIT
|
|
..D RELEASE
|
|
..Q:LRQUIT
|
|
..D:'LRZ(2) MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC)
|
|
..D OERR^LR7OB63D
|
|
.I LRSEL="C" D
|
|
..Q:$T(CPT^LRCAPES)=""
|
|
..S LRPRO=DUZ
|
|
..D PROVIDR^LRAPUTL
|
|
..Q:LRQUIT
|
|
..D CPT^LRCAPES(LRAA,LRAD,LRAN,LRPRO)
|
|
.I LRSEL="V" D
|
|
..D DEMARR
|
|
..D INIT^LRAPSNMD(LRDFN,LRSS,LRI,LRSF,LRAA,LRAN,LRAD,.LRDEM,1)
|
|
Q
|
|
TITLE ;Title
|
|
S LRQUIT=0
|
|
D CK^LRAP
|
|
I Y=-1 S LRQUIT=1 Q
|
|
W @IOF
|
|
S LRTEXT="Release/Electronically Sign Pathology Reports"
|
|
S LRMSG(1)=$$CJ^XLFSTR(LRTEXT,IOM)
|
|
S LRMSG(1,"F")="!!"
|
|
S LRMSG(2)="",LRMSG(2,"F")="!"
|
|
D EN^DDIOL(.LRMSG) K LRMSG
|
|
Q
|
|
CPTCHK ;Determine if CPT is activated
|
|
Q:$T(ES^LRCAPES)=""
|
|
S LRESCPT=$$ES^LRCAPES()
|
|
Q
|
|
DEMARR ;
|
|
I LRAU D
|
|
.S LRPRO=$$GET1^DIQ(63,LRDFN_",",13.5,"I")
|
|
.S LRPRO(1)=$$GET1^DIQ(63,LRDFN_",",13.5)
|
|
I 'LRAU D
|
|
.S LRPRO=$$GET1^DIQ(LRSF,LRI_","_LRDFN_",",.07,"I")
|
|
.S LRPRO(1)=$$GET1^DIQ(LRSF,LRI_","_LRDFN_",",.07)
|
|
S LRDEM("SEX")=SEX,LRDEM("DOB")=DOB
|
|
S LRDEM("AGE")=AGE
|
|
S LRDEM("SEC")=LRAA(1),LRDEM("PNM")=PNM
|
|
S LRDEM("SSN")=SSN,LRDEM("PRO")=LRPRO(1)
|
|
I LRAU D
|
|
.S LRDEM("DTH")=$P(VADM(6),"^",2)
|
|
.S LRDEM("AUDT")=$$GET1^DIQ(63,LRDFN_",",11)
|
|
.S LRDEM("AUTYP")=$$GET1^DIQ(63,LRDFN_",",13.7)
|
|
Q
|
|
MENU ;
|
|
N DIR,X,Y
|
|
S DIR(0)="S^"
|
|
S:LRESCPT DIR(0)=DIR(0)_"C:CPT Coding;"
|
|
S DIR(0)=DIR(0)_"E:Electronically Sign Reports;V:View SNOMED Codes"
|
|
S DIR("A")="Selection"
|
|
D ^DIR
|
|
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S LRQUIT=1 Q
|
|
S LRSEL=Y
|
|
Q
|
|
SECTION ;Choose Anatomic Pathology section (AU,SP,CY,EM)
|
|
W !
|
|
D ^LRAP
|
|
I '$D(Y)!('$D(LRSS)) S LRQUIT=1 Q
|
|
S:LRO(68)="EM" LRO(68)="ELECTRON MICROSCOPY"
|
|
S LRAU=0 ; LRAU = 0 - Not Autopsy
|
|
S:LRSS="AU" LRAU=1 ; = 1 - Autosy
|
|
I LRCAPA D Q:LRQUIT
|
|
.S X=""
|
|
.S:LRSS="CY" X="CYTOLOGY REPORTING"
|
|
.S:LRSS="SP" X="SURGICAL PATH REPORTING"
|
|
.D:X'="" X^LRUWK
|
|
.S:'$D(X) LRQUIT=1
|
|
;
|
|
S LRSOP="Z"
|
|
S LRMSG(1)=LRO(68)_" ("_LRABV_")",LRMSG(1,"F")="!?20"
|
|
S LRMSG(2)="",LRMSG(2,"F")="!"
|
|
D EN^DDIOL(.LRMSG) K LRMSG
|
|
Q
|
|
ACCYR ;Determine Accession Year
|
|
D ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
|
|
I LRAD1=-1 S LRQUIT=1 Q
|
|
I LRAD1 S LRAD=$P(LRAD1,U),LRH(0)=$P(LRAD1,U,2)
|
|
Q
|
|
RELCHK ;Perform series of checks
|
|
N LRPAT,LRSRLST,LRSRREL
|
|
S LRQUIT=0
|
|
I 'LRAU D Q:LRQUIT
|
|
.S LRPAT=+$$GET1^DIQ(LRSF,LRIENS,.02,"I")
|
|
.S LRZ=$$GET1^DIQ(LRSF,LRIENS,.03,"I")
|
|
.S LRZ(1)=$$GET1^DIQ(LRSF,LRIENS,.13,"I")
|
|
.S LRZ(1.1)=$$GET1^DIQ(LRSF,LRIENS,.13)
|
|
.S LRZ(2)=$$GET1^DIQ(LRSF,LRIENS,.11,"I")
|
|
.I 'LRZ,'LRZ(2) D
|
|
..W $C(7)
|
|
..S LRMSG="No date report completed. Cannot release."
|
|
..D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|
..S LRQUIT=1
|
|
I LRAU D Q:LRQUIT
|
|
.I $G(^LR(LRDFN,"AU"))="" D Q
|
|
..S LRMSG="No information found for this accession in the "
|
|
..S LRMSG=LRMSG_"LAB DATA file (#63)."
|
|
..D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|
..S LRQUIT=1
|
|
.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")
|
|
.;KLL-CHECK FOR PROVISIONAL DATE OR DATE REPORT COMPLETED
|
|
.S LRZ(3)=$$GET1^DIQ(63,LRDFN_",",14.9,"I")
|
|
.I 'LRZ,'LRZ(3) D
|
|
..W $C(7)
|
|
..S LRMSG="Provisional or date report completed required. Cannot release."
|
|
..D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|
..S LRQUIT=1
|
|
I 'LRPAT,'LRZ(2) D
|
|
.W $C(7)
|
|
.S LRMSG="Pathologist or Cytotechnologist entry missing. Cannot release."
|
|
.D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|
.S LRQUIT=1
|
|
D:'LRZ(2) SUPCHK^LRAPR1
|
|
Q:LRQUIT
|
|
I LRZ(2) D Q:LRQUIT
|
|
.W $C(7)
|
|
.S LRMSG="Report " S:LRZ(2)=1 LRMSG=LRMSG_"has already been "
|
|
.S LRMSG=LRMSG_"released "
|
|
.S Y=LRZ(2) D DD^%DT S:LRZ(2)>1 LRMSG=LRMSG_Y
|
|
.S:LRZ(1)'="" LRMSG=LRMSG_" by "_LRZ(1.1)
|
|
.D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|
.S:'LRAU LRQUIT=1
|
|
;KLL-DON'T ALLOW UNRELEASE IF REPT COMPLETED DATE EXISTS FOR AU
|
|
I LRZ(2),LRZ S LRQUIT=1
|
|
S LRMSG="" D EN^DDIOL(LRMSG,"","!") K LRMSG
|
|
;Don't allow unrelease if supp report not released for AU
|
|
I LRZ(2),'LRZ D
|
|
.S LRSRLST=$P($G(^LR(LRDFN,84,0)),"^",4)
|
|
.Q:'LRSRLST
|
|
.S LRSRREL=$P($G(^LR(LRDFN,84,LRSRLST,0)),"^",2)
|
|
.I 'LRSRREL D
|
|
..S LRMSG=$C(7)_"Supplementary report has not been released. "
|
|
..S LRMSG=LRMSG_"Cannot use this option."
|
|
..D EN^DDIOL(LRMSG,"","!!") K LRMSG
|
|
..S LRQUIT=1
|
|
Q:LRQUIT
|
|
I LRZ(2),'LRZ D
|
|
.S DIR(0)="YA",DIR("B")="NO"
|
|
.S DIR("A")="Unrelease report? "
|
|
.D ^DIR
|
|
.I 'Y S LRQUIT=1
|
|
Q
|
|
BROWSE ;Display the report in the browser
|
|
S DIR(0)="YA",DIR("B")="YES"
|
|
S DIR("A")="View the report before signing? "
|
|
D ^DIR Q:'Y
|
|
K ^TMP("LRAPBR",$J)
|
|
S LRMSG="*** Report is being processed. One moment please. ***"
|
|
S LRMSG=$$CJ^XLFSTR(LRMSG,IOM)
|
|
D EN^DDIOL(LRMSG,"","!!")
|
|
D INIT^LRAPBR(LRAA,LRSS,LRI,LRDFN,LRO(68),LRAU,0)
|
|
Q
|
|
ESIG ;Prompt for electronic signature
|
|
S LRQUIT=0
|
|
D SIG^XUSESIG
|
|
I X1="" D Q
|
|
.W " SIGNATURE NOT VERIFIED"
|
|
.S LRQUIT=1
|
|
Q
|
|
TIUPREP ;
|
|
K ^TMP("TIUP",$J)
|
|
S LRMSG="*** Report is being processed"
|
|
;Exclude patient files 67, 67.1, 67.2, 67.3, 62.3 from TIU storage
|
|
I LRDPF'=62.3,LRDPF'[67 S LRMSG=LRMSG_" for storage in TIU"
|
|
S LRMSG=LRMSG_". One moment please. ***"
|
|
S LRMSG=$$CJ^XLFSTR(LRMSG,IOM)
|
|
D EN^DDIOL(LRMSG,"","!!")
|
|
D INIT^LRAPBR(LRAA,LRSS,LRI,LRDFN,LRO(68),LRAU,1,LRNTIME)
|
|
Q
|
|
RELEASE ;
|
|
I 'LRAU D
|
|
.S LRRC=$$GET1^DIQ(LRSF,LRIENS,.1,"I")
|
|
.I LRCAPA,'LRAU D C^LRAPSWK
|
|
.S DR=".11////^S X=LRNTIME;.13////^S X=DUZ"
|
|
.S DIE="^LR(LRDFN,LRSS,",DA=LRI,DA(1)=LRDFN
|
|
.;KLL-Set LRA for xref call to LRWOMEN
|
|
.S LRA=^LR(LRDFN,LRSS,LRI,0)
|
|
I LRAU D
|
|
.S DR="14.7////^S X=$S(LRZ(2):""@"",1:LRNTIME);"
|
|
.S DR=DR_"14.8////^S X=$S(LRZ(2):""@"",1:DUZ);"
|
|
.S DIE="^LR(",DA=LRDFN
|
|
D CK^LRU
|
|
Q:$D(LR("CK"))
|
|
D ^DIE
|
|
D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))
|
|
D FRE^LRU
|
|
S LRMSG="*** Report "
|
|
I LRZ(2),LRAU S LRMSG=LRMSG_"un"
|
|
S LRMSG=LRMSG_"released. ***"
|
|
D EN^DDIOL($$CJ^XLFSTR(LRMSG,IOM),"","!!") K MSG
|
|
I "CYSP"[LRSS,LRCAPA D WKLD Q
|
|
;I LRCAPA,"SPCYEM"[LRSS,LRD(1)'="","MBA"[LRD(1) D C1^LRAPSWK
|
|
Q
|
|
STORE ;Store report in TIU
|
|
N LRTITLE,LRIENS,LRFILE,LRFDA,LRTIUPTR
|
|
;Display informational message if referral patient
|
|
I LRDPF=62.3!(LRDPF[67) D REFRRL^LRAPUTL Q
|
|
;KLL-EDIT ADDED FOR MULTIDIVISIONAL LABS,TRANSLATE LRSS TO CORRECT
|
|
; NAME TO ENSURE SUCCESSFUL MATCH IN TIU(8925.1)
|
|
S:LRSS="SP" LRO68="SURGICAL PATHOLOGY"
|
|
S:LRSS="CY" LRO68="CYTOPATHOLOGY"
|
|
S:LRSS="EM" LRO68="ELECTRON MICROSCOPY"
|
|
S:LRSS="AU" LRO68="AUTOPSY"
|
|
S LRTITLE=$$FIND1^DIC(8925.1,,"O","LR "_LRO68_" REPORT")
|
|
D NEW^TIUPNAPI(.LRTIUPTR,DFN,DUZ,LRNTIME,LRTITLE,,,,DUZ)
|
|
I +LRTIUPTR=-1 D Q
|
|
.S LRMSG="*** Report storage in TIU failed. ***"
|
|
.S LRMSG=$$CJ^XLFSTR(LRMSG,IOM)
|
|
.D EN^DDIOL(LRMSG,"","!!")
|
|
.S LRQUIT=1
|
|
S LRMSG="*** Report storage in TIU is complete. ***"
|
|
S LRMSG=$$CJ^XLFSTR(LRMSG,IOM)
|
|
D EN^DDIOL(LRMSG,"","!!")
|
|
;KLL-Calculate checksum of TIU report text
|
|
S LRVAL="^TIU(8925,"_+LRTIUPTR_",""TEXT"")"
|
|
S LRCHKSUM=$$CHKSUM^XUSESIG1(LRVAL)
|
|
;Store pointer & checksum information in the LAB DATA (#63) file
|
|
S LRIENS="+1,"_$S('LRAU:LRI_",",1:"")_LRDFN_","
|
|
S LRFILE=$S(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
|
|
S:LRFILE="" LRFILE=$S(LRSS="AU":63.101,1:"")
|
|
S LRFDA(1,LRFILE,LRIENS,.01)=LRNTIME
|
|
S LRFDA(1,LRFILE,LRIENS,1)=+LRTIUPTR
|
|
S LRFDA(1,LRFILE,LRIENS,2)=LRCHKSUM
|
|
D UPDATE^DIE("","LRFDA(1)")
|
|
D RETRACT^LRAPRES1(LRDFN,LRSS,LRI,+LRTIUPTR)
|
|
Q
|
|
WKLD ;Capture workload
|
|
K LRFDA,ERR,IENS,OROUT,ORIEN
|
|
S LRK=$P(^LR(LRDFN,LRSS,LRI,0),"^",11) Q:'LRK
|
|
Q:$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0))
|
|
S RNUM=1
|
|
S IENS="+"_RNUM_","_LRAN_","_LRAD_","_LRAA_","
|
|
S FILE=68.04,ORIEN(1)=LRT
|
|
S LRFDA(1,FILE,IENS,.01)=LRT
|
|
S LRFDA(1,FILE,IENS,1)=50
|
|
S LRFDA(1,FILE,IENS,3)=DUZ
|
|
S LRFDA(1,FILE,IENS,4)=LRK
|
|
S FILE1=68.14
|
|
S C=0 F S C=$O(LRT(C)) Q:'C D
|
|
.S RNUM=RNUM+1
|
|
.S ORIEN(RNUM)=C
|
|
.S IENS1="+"_RNUM_","_IENS
|
|
.S LRFDA(1,FILE1,IENS1,.01)=C
|
|
.S LRFDA(1,FILE1,IENS1,.02)=1
|
|
.S LRFDA(1,FILE1,IENS1,.03)=0
|
|
.S LRFDA(1,FILE1,IENS1,.04)=0
|
|
.S LRFDA(1,FILE1,IENS1,1)=LRK
|
|
.S LRFDA(1,FILE1,IENS1,2)=DUZ
|
|
.S LRFDA(1,FILE1,IENS1,3)=DUZ(2)
|
|
.S LRFDA(1,FILE1,IENS1,4)=LRAA
|
|
.S LRFDA(1,FILE1,IENS1,5)=LRAA
|
|
.S LRFDA(1,FILE1,IENS1,6)=LRAA
|
|
D UPDATE^DIE("","LRFDA(1)","ORIEN","OROUT")
|
|
Q
|
|
END ;Clean-up variables and quit
|
|
K LRAD1,LRDATA,LRAU,LRRDTE,LRTEXT,LRSEL,LRFILE,LRIENS,LRIENS1
|
|
K LRFDA,ERR,IENS,OROUT,ORIEN,LRTMP
|
|
K ^TMP("LRAPBR",$J),^TMP("TIUP",$J)
|
|
D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES
|
|
D V^LRU
|
|
Q
|