LRVRAR ;DALOI/STAFF - AUTO RELEASE VERIFICATION ;9/26/16 12:37
;;5.2;LAB SERVICE;**458,475,484**;Sep 27, 1994;Build 2
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
;
; Variables:
; DUZ = set to IEN of LRLAB,AUTO RELEASE application proxy in file #200
;
; LRDUZ = set to IEN of either:
; 1. File #200 entry of LRLAB,AUTO VERIFY application proxy (LRDUZ("AV") if results were auto verified.
; 2. File #200 entry of LRLAB,AUTO RELEASE application proxy (LRDUZ("AR") when results are auto released.
;
; LRDUZ("AR") = set to IEN of LRLAB,AUTO RELEASE application proxy in file #200
; LRDUZ("AV") = set to IEN of LRLAB,AUTO VERIFY application proxy in file #200
;
; The variable LRDUZ is set in different places to one of the values in the LRDUZ array to represent the "user"
; for the software to use within the context of the operation to record who released the results and who performed
; the testing.
;
;
EN ; Entry Point
; - call with LRLL=Load/Worklist IEN
;
;ZEXCEPT: LRLL,ZTREQ,ZTSTOP
;
N DIQUIET,LA7624,LA76248,LA76249,LA7AAT,LAMSG,LRANYAA,LRAUTORELEASE,LRAUTOVERIFY,LRDELTACHKOK,LREND,LRERR,LRSQ
;
S LRLL=+$G(LRLL)
;
; If no entries to process then quit
I '$D(^LAH(LRLL,1,"AUTOREL")) S:$D(ZTQUEUED) ZTREQ="@" Q
;
; See if already running and/or no one else is using this loasd list, i.e. user using EA (LRVR) to verify instrument data.
L +^LAH("Z",LRLL):DILOCKTM+10
E S ZTREQ=$$HADD^XLFDT($H,0,0,5,0) D END Q
;
D INIT^LRVRARU
I LREND D Q
. D XQA^LA7UXQA(2,0,0,0,LAMSG,"")
. D END
;
S LRSQ=0
F S LRSQ=$O(^LAH(LRLL,1,"AUTOREL",LRSQ)) Q:LRSQ<1 D
. I $$S^%ZTLOAD("Processing loadlist "_$P(LRLL(0),"^")_", entry #"_LRSQ) S ZTSTOP=1 Q ; Task has been requested to stop
. K LRERR
. S LA7624=$P(^LAH(LRLL,1,"AUTOREL",LRSQ),U,2)
. ; Interface message number in ^LAHM(62.49
. S LA76249=+$P($G(^LAH(LRLL,1,LRSQ,0)),U,13)
. ; File #62.48 configuration link
. S LA76248=""
. I LA76249 S LA76248=$$GET1^DIQ(62.49,LA76249_",",.5,"I")
. D LOOK,NEXT
D END
Q
;
;
NEXT ; Clean up between entries
;
;ZEXCEPT: LRERR,LRLL,LRSQ,LRUID
;
; If no errors then remove record from LAH.
I $G(LRERR)<1 D ZAPALL^LRVR3(LRLL,LRSQ)
;
D CLEAN^LRVRARU
Q
;
;
END ; Clean up and quit
;ZEXCEPT: LRLL,ZTQUEUED,ZTREQ
;
; Release locks
L -^LAH("Z",LRLL)
;
D SPALERT^LRVRARU,KVAR^VADPT,KILL^XUSCLEAN
K ^TMP("LR",$J)
I $D(ZTQUEUED),'$P($G(ZTREQ),"^") S ZTREQ="@"
Q
;
;
LOOK ; Check for data
;
;ZEXCEPT: DFN,ERR,LRAA,LRAD,LRAN,LRDFN,LRDPF,LREND,LRERR,LRIDT,LRLL,LRLLOC,LRODT,LRORD,LRORU3,LRSN,LRSQ,PNM,X,ZTREQ
;
N LRCDT,LRLDT,LRLOCKER,LRSS,LRUID
;
K LRDFN,LRERR,ERR,LRDPF,PNM,X
S (LREND,LRERR)=0
;
S LRUID=$P($G(^LAH(LRLL,1,LRSQ,.3)),U)
I LRUID="" D Q
. ; JMC/5/6/15 - need to write error message when UID not found with data in LAH
. S LREND=1
;
D UID^LRVRA
;
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
S LRDFN=+X,LRDPF=$P(X,U,2),DFN=$P(^LR(LRDFN,0),U,3)
S LRODT=+$P(X,U,4),LRSN=+$P(X,U,5),LRLLOC=$P(X,U,7)
S LRSS=$P(^LRO(68,LRAA,0),U,2)
;
S:'$L(LRLLOC) LRLLOC=0
S LRORD=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^")
;
S X(3)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
S LRCDT=$P(X(3),U,1)
S LRIDT=$P(X(3),U,5)
S:'LRIDT LRIDT=9999999-X(3)
S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
;
D DEM^LRX
I $G(LREND) S LRDFN=0 Q
;
; Lock records in file #63 and 68
L +(^LR(LRDFN,LRSS,LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN)):DILOCKTM+10
I '$T D Q
. S ZTREQ=$$HADD^XLFDT($H,0,0,5,0)
. S LRERR=1
;
D DATA
;
L -(^LR(LRDFN,LRSS,LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN))
;
; If error encountered then remove from auto release queue/process
I $G(LRERR)>0 D
. K ^LAH(LRLL,1,"AUTOREL",LRSQ)
. K ^LAH(LRLL,1,"AUTOREL-UID",LRUID,LRSQ)
;
Q
;
;
DATA ;Process data and store in LR global
;
;ZEXCEPT: LA76248,LA76249,LA7AAT,LR642,LRAA,LRALERT,LRAUTOVERIFY,LRCDT,LRCNT,LRCOM,LRCUP,LRDATA,LRDFN,LRDFWKLD,LREII,LRERR
;ZEXCEPT: LRIDT,LRLDT,LRLL,LRMETH,LRNOW,LROKTORELEASE,LROUTINE,LRSAMP,LRSB,LRSPEC,LRSQ,LRSS,LRSTORE,LRTM60,LRTRAY
;ZEXCEPT: LRTS,LRTST,LRUID,LRUSI,LRVF,LRVTS,LRX,LRY,LRZ
;
K LRCNT,LRDATA,LRERR,LREII,LRLDT,LRNOW,LRSAMP,LRSB,LRSPEC,LRTM60,LRTRAY,LRCUP,LRTS,LRVF,LRX,LRY,LRZ
S (LR642,LRCNT,LRERR)=0
;
; Get type of HL7 application ACK
S LA7AAT(1)=$P($G(^LAH(LRLL,1,"AUTOREL-UID",LRUID,LRSQ,LA76249)),U)
;
; Setup workload suffix and workload variables
I LR642<1 S LR642=LRDFWKLD
D WKLD^LRVRARU(LR642)
D WKLDC^LRVRARU(LRLL,LRAA)
;
S LRSPEC=$P(^LR(LRDFN,"CH",LRIDT,0),U,5)
;
; Check if verified results exist in ^LR then delete results from LAH and mark as error.
S LRVF=+$P(^LR(LRDFN,"CH",LRIDT,0),U,3)
I LRVF D
. S LRX=1
. F S LRX=$O(^LR(LRDFN,"CH",LRIDT,LRX)) Q:LRX'>0 D
. . S LRZ=^LR(LRDFN,"CH",LRIDT,LRX)
. . I $P(LRZ,U)'="",$P(LRZ,U)'="pending",$D(^LAH(LRLL,1,LRSQ,LRX)) K ^LAH(LRLL,1,LRSQ,LRX) S:LRERR=0 LRERR=$$CREATE^LA7LOG(307,1)
I LRERR D SENDACK^LRVRARU Q
;
; Check if results have datanames/tests on this profile and user is valid
S LRDATA=1
F S LRDATA=$O(^LAH(LRLL,1,LRSQ,LRDATA)) Q:LRDATA<1 D Q:LRERR
. S LRDATA(LRDATA)=^LAH(LRLL,1,LRSQ,LRDATA)
. I $P(LRDATA(LRDATA),"^",4)<1 S LRERR=$$CREATE^LA7LOG(111,1) Q
. S LROKTORELEASE=$$OKTOREL
. I 'LROKTORELEASE D Q
. . N LRDUZ
. . I $P(LROKTORELEASE,U,2) S LRDUZ=$P(LROKTORELEASE,U,3),LRERR=$$CREATE^LA7LOG($P(LROKTORELEASE,U,2),1)
. S LRDUZ("USER")=$P(LROKTORELEASE,U,2)
. S LRAUTOVERIFY=LROKTORELEASE-1
. S LREII=$P(LRDATA(LRDATA),U,11)
. S LREII=LREII_";"_$S(LRAUTOVERIFY:"LRAV",1:"LRTV")
. S $P(LRDATA(LRDATA),U,11)=LREII ; Store auto verify or tech verify with EII.
. S LRTST=+$G(LRVTS(LRDATA))
. I 'LRTST S LRERR=$$CREATE^LA7LOG(116,1) Q
. I '$D(^TMP("LR",$J,"VTO",LRTST)) S LRERR=$$CREATE^LA7LOG(118,1) Q
;
I LRERR D SENDACK^LRVRARU Q
;
; Calculate days back for delta checks
S LRTM60=$$LRTM60^LRVR(LRCDT)
; Find previous specimen
S LRLDT=LRIDT
D FINDPS^LRGV2
;
; Store ^LR( data [results]
K LRCOM
S LRVF=0,LRALERT=LROUTINE,LRUSI="LRAR"
;
; Store any new methods with existing methods on file.
S LRMETH=$P(^LAH(LRLL,1,LRSQ,0),U,7)_"(AR)"
I $P($G(^LR(LRDFN,LRSS,LRIDT,0)),U,8)'="" D
. N I,X
. S X=$P(^LR(LRDFN,LRSS,LRIDT,0),U,8)
. F I=1:1:$L(X,";") I $P(X,";",I)'="",LRMETH'[$P(X,";",I) S LRMETH=LRMETH_";"_$P(X,";",I)
I LRMETH'="" S $P(^LR(LRDFN,LRSS,LRIDT,0),U,8)=LRMETH
;
M LRSB=LRDATA
D TEST^LRVR1
S LRSB=1,LRNOW=$$NOW^XLFDT
F S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 D STORE Q:LRERR
;
I LRERR D SENDACK^LRVRARU Q
;
; Set releasing user to auto release proxy.
S LRDUZ=LRDUZ("AR")
;
; Call to set data and comments
I $O(LRSB(0)) D
. D LRSBCOM^LRVR4,A3^LRVR3
. S LRSTORE=LRSTORE+1
. I $G(LA76248) S LRSTORE(LA76248)=$G(LRSTORE(LA76248))+1
;
; Send application ack back to sending application interface
D SENDACK^LRVRARU
Q
;
;
STORE ; Store the data in LR global
;
;ZEXCEPT: LRAUTOVERIFY,LRDEL,LRDELTACHKOK,LRDFN,LRDUZ,LRERR,LRIDT,LRLDT,LRNOW,LRSB,LRSS
;
N I,LRNGS,LRQ,LRTS,LRX,LRY,X,X1,Y
;
I '$G(^TMP("LR",$J,"TMP",LRSB,"P")) S LRERR=$$CREATE^LA7LOG(117,1) Q
;
; START CHANGE FOR LR*5.2*484
S LRTS=$G(^TMP("LR",$J,"TMP",LRSB))
; END CHANGE FOR LR*5.2*484
;
S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3)
F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I)
S $P(LRSB(LRSB),U,3)=LRY
S LRTS=$G(^TMP("LR",$J,"TMP",LRSB))
D V25^LRVER5
S LRX=LRNGS,LRY=$P(LRSB(LRSB),U,5)
;
; Do delta checking if enabled
I LRDELTACHKOK D
. S X=$P(LRSB(LRSB),"^"),Y=0,(LRQ,X1)=""
. I LRLDT>0 S X1=$P($G(^LR(LRDFN,LRSS,LRLDT,LRSB)),U)
. I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA ;S:Y LRDELTA=Y
;
; Store the file #60 units/ranges/etc values which don't come from the
; middleware so verified results can be edited in vista with the
; configuration values at the time of original verification
; (#.01) SITE/SPECIMEN [1P:61] ^ (#1) REFERENCE LOW [2F] ^ (#2) REFERENCE HIGH [3F] ^ (#3) CRITICAL LOW [4F] ^ (#4) CRITICAL HIGH [5F] ^ ^ (#6) UNITS [7F] ^ (#7) TYPE OF DELTA CHECK [8P:62.1] ^
; (#8) DELTA VALUE [9F] ^ (#9) DEFAULT VALUE [10F] ^ (#9.2) THERAPEUTIC LOW [11F] ^ (#9.3) THERAPEUTIC HIGH [12F] ^
F I=1,4,5,8:1:12 I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,U,I)
S $P(LRSB(LRSB),U,5)=LRY
;
S $P(LRSB(LRSB),U,6)=LRNOW
;
; Store performing lab based on LRDUZ(2) from load/list profile.
S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),1:$G(DUZ(2)))
;
S ^LR(LRDFN,"CH",LRIDT,LRSB)=LRSB(LRSB)
;
Q
;
;
OKTOREL() ; Determine if it's OK to store these results for auto release
;
;ZEXCEPT: LRDATA,LRDUZ,LRLL,LRSQ
;
; Returns OK = "" (no "user")
; = 0 (results not flagged for auto release)
; = 0^error code (62.485)^invalid user duz
; = 1^duz of user (tech verify)
; = 2 (auto verify user)
;
N OK,LRX,LRY
;
S OK=""
;
I $P($G(^LAH(LRLL,1,LRSQ,LRDATA)),U)="" S OK=0
;
; Results not flagged for auto release.
I '$D(^LAH(LRLL,1,"AUTOREL",LRSQ,LRDATA)) S OK=0
;
; Retrieve stored auto release setting when this result arrived.
S LRX=$P(^LAH(LRLL,1,"AUTOREL",LRSQ,LRDATA),U,2)
;
; Retrieve user id/duz received with results.
S LRY=$P(LRDATA(LRDATA),U,4)
;
I OK="" D
. ; If no user or auto release proxy then log error
. I LRY<1 S OK="0^303" Q
. I LRY=LRDUZ("AR") S OK="0^304"_U_LRY Q
. ;
. ; If auto release on for auto or tech verify
. I LRX=1 D Q
. . I LRY=LRDUZ("AV") S OK=2 Q
. . S OK=1_U_LRY Q
. ;
. ; If auto release on for auto verify only
. I LRX=2 D Q
. . I LRY=LRDUZ("AV") S OK=2 Q
. . S OK="0^305"_U_LRY
. ;
. ; If auto release on for tech verify only
. I LRX=3 D Q
. . I LRY'=LRDUZ("AV"),LRY'=LRDUZ("AR") S OK=1_U_LRY Q
. . S OK="0^306"_U_LRY
;
; Check if tech verify that user owns LRVERIFY security key.
I $P(OK,U)=1 D
. N LRKEY
. ;
. ; check if user is active
. I '$$ACTIVE^XUSER($P(OK,U,2)) S OK="0^302^"_$P(OK,U,2) Q
. ;
. ; check that user has LRVERIFY key
. D OWNSKEY^XUSRB(.LRKEY,"LRVERIFY",$P(OK,U,2))
. I LRKEY(0)=1 Q
. S OK="0^301^"_$P(OK,U,2)
;
Q OK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRAR 10404 printed Apr 09, 2024@21:24:47 Page 2
LRVRAR ;DALOI/STAFF - AUTO RELEASE VERIFICATION ;9/26/16 12:37
+1 ;;5.2;LAB SERVICE;**458,475,484**;Sep 27, 1994;Build 2
+2 ;
+3 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+4 ; used in conjunction with Eclipse M-editor.
+5 ;
+6 ; Variables:
+7 ; DUZ = set to IEN of LRLAB,AUTO RELEASE application proxy in file #200
+8 ;
+9 ; LRDUZ = set to IEN of either:
+10 ; 1. File #200 entry of LRLAB,AUTO VERIFY application proxy (LRDUZ("AV") if results were auto verified.
+11 ; 2. File #200 entry of LRLAB,AUTO RELEASE application proxy (LRDUZ("AR") when results are auto released.
+12 ;
+13 ; LRDUZ("AR") = set to IEN of LRLAB,AUTO RELEASE application proxy in file #200
+14 ; LRDUZ("AV") = set to IEN of LRLAB,AUTO VERIFY application proxy in file #200
+15 ;
+16 ; The variable LRDUZ is set in different places to one of the values in the LRDUZ array to represent the "user"
+17 ; for the software to use within the context of the operation to record who released the results and who performed
+18 ; the testing.
+19 ;
+20 ;
EN ; Entry Point
+1 ; - call with LRLL=Load/Worklist IEN
+2 ;
+3 ;ZEXCEPT: LRLL,ZTREQ,ZTSTOP
+4 ;
+5 NEW DIQUIET,LA7624,LA76248,LA76249,LA7AAT,LAMSG,LRANYAA,LRAUTORELEASE,LRAUTOVERIFY,LRDELTACHKOK,LREND,LRERR,LRSQ
+6 ;
+7 SET LRLL=+$GET(LRLL)
+8 ;
+9 ; If no entries to process then quit
+10 IF '$DATA(^LAH(LRLL,1,"AUTOREL"))
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+11 ;
+12 ; See if already running and/or no one else is using this loasd list, i.e. user using EA (LRVR) to verify instrument data.
+13 LOCK +^LAH("Z",LRLL):DILOCKTM+10
+14 IF '$TEST
SET ZTREQ=$$HADD^XLFDT($HOROLOG,0,0,5,0)
DO END
QUIT
+15 ;
+16 DO INIT^LRVRARU
+17 IF LREND
Begin DoDot:1
+18 DO XQA^LA7UXQA(2,0,0,0,LAMSG,"")
+19 DO END
End DoDot:1
QUIT
+20 ;
+21 SET LRSQ=0
+22 FOR
SET LRSQ=$ORDER(^LAH(LRLL,1,"AUTOREL",LRSQ))
if LRSQ<1
QUIT
Begin DoDot:1
+23 ; Task has been requested to stop
IF $$S^%ZTLOAD("Processing loadlist "_$PIECE(LRLL(0),"^")_", entry #"_LRSQ)
SET ZTSTOP=1
QUIT
+24 KILL LRERR
+25 SET LA7624=$PIECE(^LAH(LRLL,1,"AUTOREL",LRSQ),U,2)
+26 ; Interface message number in ^LAHM(62.49
+27 SET LA76249=+$PIECE($GET(^LAH(LRLL,1,LRSQ,0)),U,13)
+28 ; File #62.48 configuration link
+29 SET LA76248=""
+30 IF LA76249
SET LA76248=$$GET1^DIQ(62.49,LA76249_",",.5,"I")
+31 DO LOOK
DO NEXT
End DoDot:1
+32 DO END
+33 QUIT
+34 ;
+35 ;
NEXT ; Clean up between entries
+1 ;
+2 ;ZEXCEPT: LRERR,LRLL,LRSQ,LRUID
+3 ;
+4 ; If no errors then remove record from LAH.
+5 IF $GET(LRERR)<1
DO ZAPALL^LRVR3(LRLL,LRSQ)
+6 ;
+7 DO CLEAN^LRVRARU
+8 QUIT
+9 ;
+10 ;
END ; Clean up and quit
+1 ;ZEXCEPT: LRLL,ZTQUEUED,ZTREQ
+2 ;
+3 ; Release locks
+4 LOCK -^LAH("Z",LRLL)
+5 ;
+6 DO SPALERT^LRVRARU
DO KVAR^VADPT
DO KILL^XUSCLEAN
+7 KILL ^TMP("LR",$JOB)
+8 IF $DATA(ZTQUEUED)
IF '$PIECE($GET(ZTREQ),"^")
SET ZTREQ="@"
+9 QUIT
+10 ;
+11 ;
LOOK ; Check for data
+1 ;
+2 ;ZEXCEPT: DFN,ERR,LRAA,LRAD,LRAN,LRDFN,LRDPF,LREND,LRERR,LRIDT,LRLL,LRLLOC,LRODT,LRORD,LRORU3,LRSN,LRSQ,PNM,X,ZTREQ
+3 ;
+4 NEW LRCDT,LRLDT,LRLOCKER,LRSS,LRUID
+5 ;
+6 KILL LRDFN,LRERR,ERR,LRDPF,PNM,X
+7 SET (LREND,LRERR)=0
+8 ;
+9 SET LRUID=$PIECE($GET(^LAH(LRLL,1,LRSQ,.3)),U)
+10 IF LRUID=""
Begin DoDot:1
+11 ; JMC/5/6/15 - need to write error message when UID not found with data in LAH
+12 SET LREND=1
End DoDot:1
QUIT
+13 ;
+14 DO UID^LRVRA
+15 ;
+16 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
+17 SET LRDFN=+X
SET LRDPF=$PIECE(X,U,2)
SET DFN=$PIECE(^LR(LRDFN,0),U,3)
+18 SET LRODT=+$PIECE(X,U,4)
SET LRSN=+$PIECE(X,U,5)
SET LRLLOC=$PIECE(X,U,7)
+19 SET LRSS=$PIECE(^LRO(68,LRAA,0),U,2)
+20 ;
+21 if '$LENGTH(LRLLOC)
SET LRLLOC=0
+22 SET LRORD=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^")
+23 ;
+24 SET X(3)=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
+25 SET LRCDT=$PIECE(X(3),U,1)
+26 SET LRIDT=$PIECE(X(3),U,5)
+27 if 'LRIDT
SET LRIDT=9999999-X(3)
+28 SET LRORU3=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
+29 ;
+30 DO DEM^LRX
+31 IF $GET(LREND)
SET LRDFN=0
QUIT
+32 ;
+33 ; Lock records in file #63 and 68
+34 LOCK +(^LR(LRDFN,LRSS,LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN)):DILOCKTM+10
+35 IF '$TEST
Begin DoDot:1
+36 SET ZTREQ=$$HADD^XLFDT($HOROLOG,0,0,5,0)
+37 SET LRERR=1
End DoDot:1
QUIT
+38 ;
+39 DO DATA
+40 ;
+41 LOCK -(^LR(LRDFN,LRSS,LRIDT),^LRO(68,LRAA,1,LRAD,1,LRAN))
+42 ;
+43 ; If error encountered then remove from auto release queue/process
+44 IF $GET(LRERR)>0
Begin DoDot:1
+45 KILL ^LAH(LRLL,1,"AUTOREL",LRSQ)
+46 KILL ^LAH(LRLL,1,"AUTOREL-UID",LRUID,LRSQ)
End DoDot:1
+47 ;
+48 QUIT
+49 ;
+50 ;
DATA ;Process data and store in LR global
+1 ;
+2 ;ZEXCEPT: LA76248,LA76249,LA7AAT,LR642,LRAA,LRALERT,LRAUTOVERIFY,LRCDT,LRCNT,LRCOM,LRCUP,LRDATA,LRDFN,LRDFWKLD,LREII,LRERR
+3 ;ZEXCEPT: LRIDT,LRLDT,LRLL,LRMETH,LRNOW,LROKTORELEASE,LROUTINE,LRSAMP,LRSB,LRSPEC,LRSQ,LRSS,LRSTORE,LRTM60,LRTRAY
+4 ;ZEXCEPT: LRTS,LRTST,LRUID,LRUSI,LRVF,LRVTS,LRX,LRY,LRZ
+5 ;
+6 KILL LRCNT,LRDATA,LRERR,LREII,LRLDT,LRNOW,LRSAMP,LRSB,LRSPEC,LRTM60,LRTRAY,LRCUP,LRTS,LRVF,LRX,LRY,LRZ
+7 SET (LR642,LRCNT,LRERR)=0
+8 ;
+9 ; Get type of HL7 application ACK
+10 SET LA7AAT(1)=$PIECE($GET(^LAH(LRLL,1,"AUTOREL-UID",LRUID,LRSQ,LA76249)),U)
+11 ;
+12 ; Setup workload suffix and workload variables
+13 IF LR642<1
SET LR642=LRDFWKLD
+14 DO WKLD^LRVRARU(LR642)
+15 DO WKLDC^LRVRARU(LRLL,LRAA)
+16 ;
+17 SET LRSPEC=$PIECE(^LR(LRDFN,"CH",LRIDT,0),U,5)
+18 ;
+19 ; Check if verified results exist in ^LR then delete results from LAH and mark as error.
+20 SET LRVF=+$PIECE(^LR(LRDFN,"CH",LRIDT,0),U,3)
+21 IF LRVF
Begin DoDot:1
+22 SET LRX=1
+23 FOR
SET LRX=$ORDER(^LR(LRDFN,"CH",LRIDT,LRX))
if LRX'>0
QUIT
Begin DoDot:2
+24 SET LRZ=^LR(LRDFN,"CH",LRIDT,LRX)
+25 IF $PIECE(LRZ,U)'=""
IF $PIECE(LRZ,U)'="pending"
IF $DATA(^LAH(LRLL,1,LRSQ,LRX))
KILL ^LAH(LRLL,1,LRSQ,LRX)
if LRERR=0
SET LRERR=$$CREATE^LA7LOG(307,1)
End DoDot:2
End DoDot:1
+26 IF LRERR
DO SENDACK^LRVRARU
QUIT
+27 ;
+28 ; Check if results have datanames/tests on this profile and user is valid
+29 SET LRDATA=1
+30 FOR
SET LRDATA=$ORDER(^LAH(LRLL,1,LRSQ,LRDATA))
if LRDATA<1
QUIT
Begin DoDot:1
+31 SET LRDATA(LRDATA)=^LAH(LRLL,1,LRSQ,LRDATA)
+32 IF $PIECE(LRDATA(LRDATA),"^",4)<1
SET LRERR=$$CREATE^LA7LOG(111,1)
QUIT
+33 SET LROKTORELEASE=$$OKTOREL
+34 IF 'LROKTORELEASE
Begin DoDot:2
+35 NEW LRDUZ
+36 IF $PIECE(LROKTORELEASE,U,2)
SET LRDUZ=$PIECE(LROKTORELEASE,U,3)
SET LRERR=$$CREATE^LA7LOG($PIECE(LROKTORELEASE,U,2),1)
End DoDot:2
QUIT
+37 SET LRDUZ("USER")=$PIECE(LROKTORELEASE,U,2)
+38 SET LRAUTOVERIFY=LROKTORELEASE-1
+39 SET LREII=$PIECE(LRDATA(LRDATA),U,11)
+40 SET LREII=LREII_";"_$SELECT(LRAUTOVERIFY:"LRAV",1:"LRTV")
+41 ; Store auto verify or tech verify with EII.
SET $PIECE(LRDATA(LRDATA),U,11)=LREII
+42 SET LRTST=+$GET(LRVTS(LRDATA))
+43 IF 'LRTST
SET LRERR=$$CREATE^LA7LOG(116,1)
QUIT
+44 IF '$DATA(^TMP("LR",$JOB,"VTO",LRTST))
SET LRERR=$$CREATE^LA7LOG(118,1)
QUIT
End DoDot:1
if LRERR
QUIT
+45 ;
+46 IF LRERR
DO SENDACK^LRVRARU
QUIT
+47 ;
+48 ; Calculate days back for delta checks
+49 SET LRTM60=$$LRTM60^LRVR(LRCDT)
+50 ; Find previous specimen
+51 SET LRLDT=LRIDT
+52 DO FINDPS^LRGV2
+53 ;
+54 ; Store ^LR( data [results]
+55 KILL LRCOM
+56 SET LRVF=0
SET LRALERT=LROUTINE
SET LRUSI="LRAR"
+57 ;
+58 ; Store any new methods with existing methods on file.
+59 SET LRMETH=$PIECE(^LAH(LRLL,1,LRSQ,0),U,7)_"(AR)"
+60 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),U,8)'=""
Begin DoDot:1
+61 NEW I,X
+62 SET X=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,8)
+63 FOR I=1:1:$LENGTH(X,";")
IF $PIECE(X,";",I)'=""
IF LRMETH'[$PIECE(X,";",I)
SET LRMETH=LRMETH_";"_$PIECE(X,";",I)
End DoDot:1
+64 IF LRMETH'=""
SET $PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,8)=LRMETH
+65 ;
+66 MERGE LRSB=LRDATA
+67 DO TEST^LRVR1
+68 SET LRSB=1
SET LRNOW=$$NOW^XLFDT
+69 FOR
SET LRSB=$ORDER(LRSB(LRSB))
if LRSB<1
QUIT
DO STORE
if LRERR
QUIT
+70 ;
+71 IF LRERR
DO SENDACK^LRVRARU
QUIT
+72 ;
+73 ; Set releasing user to auto release proxy.
+74 SET LRDUZ=LRDUZ("AR")
+75 ;
+76 ; Call to set data and comments
+77 IF $ORDER(LRSB(0))
Begin DoDot:1
+78 DO LRSBCOM^LRVR4
DO A3^LRVR3
+79 SET LRSTORE=LRSTORE+1
+80 IF $GET(LA76248)
SET LRSTORE(LA76248)=$GET(LRSTORE(LA76248))+1
End DoDot:1
+81 ;
+82 ; Send application ack back to sending application interface
+83 DO SENDACK^LRVRARU
+84 QUIT
+85 ;
+86 ;
STORE ; Store the data in LR global
+1 ;
+2 ;ZEXCEPT: LRAUTOVERIFY,LRDEL,LRDELTACHKOK,LRDFN,LRDUZ,LRERR,LRIDT,LRLDT,LRNOW,LRSB,LRSS
+3 ;
+4 NEW I,LRNGS,LRQ,LRTS,LRX,LRY,X,X1,Y
+5 ;
+6 IF '$GET(^TMP("LR",$JOB,"TMP",LRSB,"P"))
SET LRERR=$$CREATE^LA7LOG(117,1)
QUIT
+7 ;
+8 ; START CHANGE FOR LR*5.2*484
+9 SET LRTS=$GET(^TMP("LR",$JOB,"TMP",LRSB))
+10 ; END CHANGE FOR LR*5.2*484
+11 ;
+12 SET LRX=$$TMPSB^LRVER1(LRSB)
SET LRY=$PIECE(LRSB(LRSB),U,3)
+13 FOR I=1:1:$LENGTH(LRX,"!")
IF $PIECE(LRY,"!",I)=""
SET $PIECE(LRY,"!",I)=$PIECE(LRX,"!",I)
+14 SET $PIECE(LRSB(LRSB),U,3)=LRY
+15 SET LRTS=$GET(^TMP("LR",$JOB,"TMP",LRSB))
+16 DO V25^LRVER5
+17 SET LRX=LRNGS
SET LRY=$PIECE(LRSB(LRSB),U,5)
+18 ;
+19 ; Do delta checking if enabled
+20 IF LRDELTACHKOK
Begin DoDot:1
+21 SET X=$PIECE(LRSB(LRSB),"^")
SET Y=0
SET (LRQ,X1)=""
+22 IF LRLDT>0
SET X1=$PIECE($GET(^LR(LRDFN,LRSS,LRLDT,LRSB)),U)
+23 ;S:Y LRDELTA=Y
IF LRDEL'=""
SET LRQ=1
DO XDELTACK^LRVERA
End DoDot:1
+24 ;
+25 ; Store the file #60 units/ranges/etc values which don't come from the
+26 ; middleware so verified results can be edited in vista with the
+27 ; configuration values at the time of original verification
+28 ; (#.01) SITE/SPECIMEN [1P:61] ^ (#1) REFERENCE LOW [2F] ^ (#2) REFERENCE HIGH [3F] ^ (#3) CRITICAL LOW [4F] ^ (#4) CRITICAL HIGH [5F] ^ ^ (#6) UNITS [7F] ^ (#7) TYPE OF DELTA CHECK [8P:62.1] ^
+29 ; (#8) DELTA VALUE [9F] ^ (#9) DEFAULT VALUE [10F] ^ (#9.2) THERAPEUTIC LOW [11F] ^ (#9.3) THERAPEUTIC HIGH [12F] ^
+30 FOR I=1,4,5,8:1:12
IF $PIECE(LRY,"!",I)=""
SET $PIECE(LRY,"!",I)=$PIECE(LRX,U,I)
+31 SET $PIECE(LRSB(LRSB),U,5)=LRY
+32 ;
+33 SET $PIECE(LRSB(LRSB),U,6)=LRNOW
+34 ;
+35 ; Store performing lab based on LRDUZ(2) from load/list profile.
+36 SET $PIECE(LRSB(LRSB),U,9)=$SELECT($GET(LRDUZ(2)):LRDUZ(2),1:$GET(DUZ(2)))
+37 ;
+38 SET ^LR(LRDFN,"CH",LRIDT,LRSB)=LRSB(LRSB)
+39 ;
+40 QUIT
+41 ;
+42 ;
OKTOREL() ; Determine if it's OK to store these results for auto release
+1 ;
+2 ;ZEXCEPT: LRDATA,LRDUZ,LRLL,LRSQ
+3 ;
+4 ; Returns OK = "" (no "user")
+5 ; = 0 (results not flagged for auto release)
+6 ; = 0^error code (62.485)^invalid user duz
+7 ; = 1^duz of user (tech verify)
+8 ; = 2 (auto verify user)
+9 ;
+10 NEW OK,LRX,LRY
+11 ;
+12 SET OK=""
+13 ;
+14 IF $PIECE($GET(^LAH(LRLL,1,LRSQ,LRDATA)),U)=""
SET OK=0
+15 ;
+16 ; Results not flagged for auto release.
+17 IF '$DATA(^LAH(LRLL,1,"AUTOREL",LRSQ,LRDATA))
SET OK=0
+18 ;
+19 ; Retrieve stored auto release setting when this result arrived.
+20 SET LRX=$PIECE(^LAH(LRLL,1,"AUTOREL",LRSQ,LRDATA),U,2)
+21 ;
+22 ; Retrieve user id/duz received with results.
+23 SET LRY=$PIECE(LRDATA(LRDATA),U,4)
+24 ;
+25 IF OK=""
Begin DoDot:1
+26 ; If no user or auto release proxy then log error
+27 IF LRY<1
SET OK="0^303"
QUIT
+28 IF LRY=LRDUZ("AR")
SET OK="0^304"_U_LRY
QUIT
+29 ;
+30 ; If auto release on for auto or tech verify
+31 IF LRX=1
Begin DoDot:2
+32 IF LRY=LRDUZ("AV")
SET OK=2
QUIT
+33 SET OK=1_U_LRY
QUIT
End DoDot:2
QUIT
+34 ;
+35 ; If auto release on for auto verify only
+36 IF LRX=2
Begin DoDot:2
+37 IF LRY=LRDUZ("AV")
SET OK=2
QUIT
+38 SET OK="0^305"_U_LRY
End DoDot:2
QUIT
+39 ;
+40 ; If auto release on for tech verify only
+41 IF LRX=3
Begin DoDot:2
+42 IF LRY'=LRDUZ("AV")
IF LRY'=LRDUZ("AR")
SET OK=1_U_LRY
QUIT
+43 SET OK="0^306"_U_LRY
End DoDot:2
QUIT
End DoDot:1
+44 ;
+45 ; Check if tech verify that user owns LRVERIFY security key.
+46 IF $PIECE(OK,U)=1
Begin DoDot:1
+47 NEW LRKEY
+48 ;
+49 ; check if user is active
+50 IF '$$ACTIVE^XUSER($PIECE(OK,U,2))
SET OK="0^302^"_$PIECE(OK,U,2)
QUIT
+51 ;
+52 ; check that user has LRVERIFY key
+53 DO OWNSKEY^XUSRB(.LRKEY,"LRVERIFY",$PIECE(OK,U,2))
+54 IF LRKEY(0)=1
QUIT
+55 SET OK="0^301^"_$PIECE(OK,U,2)
End DoDot:1
+56 ;
+57 QUIT OK
