LRAPR1 ;DALOI/STAFF - ANAT RELEASE REPORTS CONT'D ;12/16/09 11:42
;;5.2;LAB SERVICE;**317,350**;Sep 27, 1994;Build 230
;
RELCHK ; Check to make sure all supp reports are released
N LRFILE,LRIENS,LRIENS1,LRX,LRRLS,LRFDA,LRLKFL,LRDA,LRNOSP
N LRMSG,LRSRFL,LRSRMD
S DIC("B")=""
I LRSS'="AU" D
. S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
. S LRIENS1=LRI_","_LRDFN_","
. 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- if flag is true, supp rpt has been modified, needs 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
. S LRX=0 F S LRX=$O(^LR(LRDFN,84,LRX)) Q:'LRX D
. . S LRIENS=LRX_","_LRDFN_","
. . S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
. . ;LRSRMD- if flag is true, supp rpt has been modified, needs release
. . S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
. . Q:LRSRFL&('LRSRMD)
. . S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
I $G(DIC("B")) S LRQT=1
Q
;
;
CHKSUP ; Check for unreleased supp reports for E-sign switch OFF
N LRQT,LRZ11,LRZ15,LRIENS3
S (LRQT,LRZ11,LRZ15)=0
D RELCHK
I LRQT D Q
. W !!,"All supp repts must be released before main report can be released."
I 'LRQT D
. K LRFDA
. S LRNTIME=$$NOW^XLFDT
. I 'LRAU D
. . S LRZ15=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",15)
. . S LRZ11=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11)
. . S LRIENS3=LRI_","_LRDFN_","
. . S LRFDA(LRSF,LRIENS3,.11)=LRNTIME
. . S LRFDA(LRSF,LRIENS3,.13)=DUZ
. . I 'LRZ15 S LRFDA(LRSF,LRIENS3,.15)=LRZ11
. I LRAU D
. . S LRIENS3=LRDFN_","
. . S LRFDA(63,LRIENS3,14.7)=LRNTIME
. . S LRFDA(63,LRIENS3,14.8)=DUZ
. ;S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
. ;If MODIFY SUPP REPORT flag is set, remove it at this point
. ;I LRSRMD S LRFDA(LRSF,LRIENS,.03)="@"
. D FILE^DIE("","LRFDA")
. W !!,"*** Main Report Has Been Released ***",!
;
; Check and send LEDI report back to submitting (collecting) site.
I $D(LRSS),LRSS'="AU" D LEDI^LRVR0
;
Q
;
;
UNRLSE ; Must unrelease at this point in order to successfully release below
K LRFDA
N LRREL,LRIENS3
D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$G(LRI))
I 'LRAU D
. S LRIENS3=LRI_","_LRDFN_","
. I '$G(LRREL(3)) S LRFDA(LRSF,LRIENS3,.15)=LRREL(1)
. S LRFDA(LRSF,LRIENS3,.11)="@"
. S LRFDA(LRSF,LRIENS3,.13)="@"
I LRAU D
. S LRZ(2)="" ;Must null this in order to prevent unrelease
. S LRFDA(63,LRDFN,14.7)="@"
. S LRFDA(63,LRDFN,14.8)="@"
D FILE^DIE("","LRFDA")
Q
;
;
SUPCHK ; Check Supplementary Reports
N LRSR,LRSR1,LRSR2,LRFILE,LRIENS,LRIENS1
S LRSR=0,LRSR1=1
I LRSS'="AU" D
. Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
. S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
. S LRIENS1=LRI_","_LRDFN_","
. F S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1) D
. . S LRIENS=LRSR_","_LRIENS1
. . S LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
. . I 'LRSR1 S LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
I LRSS="AU" D
. Q:'+$P($G(^LR(LRDFN,84,0)),U,4)
. S LRFILE=63.324,LRIENS1=LRDFN_","
. F S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1) D
. . S LRIENS=LRSR_","_LRIENS1
. . S LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
. . I 'LRSR1 S LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
I 'LRSR1 D
. S LRMSG="Supplementary report "_LRSR2_" has not been released. "
. S LRMSG=LRMSG_"Cannot release."
. D EN^DDIOL(LRMSG,"","!!") K LRMSG
. S LRQUIT=1
Q
;
;
CKSIGNR ; Update supp report with Releaser ID and Date/time
N LRIEN2,LRFLE,LRFL3
S LRQT2=0
I LRSS'="AU" D
. S (A,B)=0 F S A=$O(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,A)) Q:'A S B=A
. I '$D(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,B,0)) S LRQT2=1 Q
. S LRIEN2=B_","_LRDA_","_LRI_","_LRDFN_","
. S LRFLE=$S(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
. S LRFL3=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
I LRSS="AU" D
. S (A,B)=0 F S A=$O(^LR(LRDFN,84,LRDA,2,A)) Q:'A S B=A
. I '$D(^LR(LRDFN,84,LRDA,2,B,0)) S LRQT2=1 Q
. S LRIEN2=B_","_LRDA_","_LRDFN_","
. S LRFLE=$S(LRSS="AU":63.3242,1:"")
. S LRFL3=$S(LRSS="AU":63.324,1:"")
Q:LRQT2
S LRFDA(LRFLE,LRIEN2,.03)=DUZ
S LRFDA(LRFLE,LRIEN2,.04)=$$NOW^XLFDT
; Must remove supp report modified flag once supp rpt is released
S LRFDA(LRFL3,LRIENS,.03)="@"
; Set, but don't file unless unrelease required
S LRFDA2(LRFLE,LRIEN2,.03)="@"
S LRFDA2(LRFLE,LRIEN2,.04)="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPR1 4537 printed Apr 09, 2024@21:20:18 Page 2
LRAPR1 ;DALOI/STAFF - ANAT RELEASE REPORTS CONT'D ;12/16/09 11:42
+1 ;;5.2;LAB SERVICE;**317,350**;Sep 27, 1994;Build 230
+2 ;
RELCHK ; Check to make sure all supp reports are released
+1 NEW LRFILE,LRIENS,LRIENS1,LRX,LRRLS,LRFDA,LRLKFL,LRDA,LRNOSP
+2 NEW LRMSG,LRSRFL,LRSRMD
+3 SET DIC("B")=""
+4 IF LRSS'="AU"
Begin DoDot:1
+5 SET LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
+6 SET LRIENS1=LRI_","_LRDFN_","
+7 SET LRX=0
FOR
SET LRX=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,LRX))
if 'LRX
QUIT
Begin DoDot:2
+8 SET LRIENS=LRX_","_LRIENS1
+9 SET LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
+10 ;LRSRMD- if flag is true, supp rpt has been modified, needs release
+11 SET LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
+12 if LRSRFL&('LRSRMD)
QUIT
+13 SET DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
End DoDot:2
End DoDot:1
+14 IF LRSS="AU"
Begin DoDot:1
+15 SET LRFILE=63.324
+16 SET LRX=0
FOR
SET LRX=$ORDER(^LR(LRDFN,84,LRX))
if 'LRX
QUIT
Begin DoDot:2
+17 SET LRIENS=LRX_","_LRDFN_","
+18 SET LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
+19 ;LRSRMD- if flag is true, supp rpt has been modified, needs release
+20 SET LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
+21 if LRSRFL&('LRSRMD)
QUIT
+22 SET DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
End DoDot:2
End DoDot:1
+23 IF $GET(DIC("B"))
SET LRQT=1
+24 QUIT
+25 ;
+26 ;
CHKSUP ; Check for unreleased supp reports for E-sign switch OFF
+1 NEW LRQT,LRZ11,LRZ15,LRIENS3
+2 SET (LRQT,LRZ11,LRZ15)=0
+3 DO RELCHK
+4 IF LRQT
Begin DoDot:1
+5 WRITE !!,"All supp repts must be released before main report can be released."
End DoDot:1
QUIT
+6 IF 'LRQT
Begin DoDot:1
+7 KILL LRFDA
+8 SET LRNTIME=$$NOW^XLFDT
+9 IF 'LRAU
Begin DoDot:2
+10 SET LRZ15=$PIECE($GET(^LR(LRDFN,LRSS,LRI,0)),"^",15)
+11 SET LRZ11=$PIECE($GET(^LR(LRDFN,LRSS,LRI,0)),"^",11)
+12 SET LRIENS3=LRI_","_LRDFN_","
+13 SET LRFDA(LRSF,LRIENS3,.11)=LRNTIME
+14 SET LRFDA(LRSF,LRIENS3,.13)=DUZ
+15 IF 'LRZ15
SET LRFDA(LRSF,LRIENS3,.15)=LRZ11
End DoDot:2
+16 IF LRAU
Begin DoDot:2
+17 SET LRIENS3=LRDFN_","
+18 SET LRFDA(63,LRIENS3,14.7)=LRNTIME
+19 SET LRFDA(63,LRIENS3,14.8)=DUZ
End DoDot:2
+20 ;S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
+21 ;If MODIFY SUPP REPORT flag is set, remove it at this point
+22 ;I LRSRMD S LRFDA(LRSF,LRIENS,.03)="@"
+23 DO FILE^DIE("","LRFDA")
+24 WRITE !!,"*** Main Report Has Been Released ***",!
End DoDot:1
+25 ;
+26 ; Check and send LEDI report back to submitting (collecting) site.
+27 IF $DATA(LRSS)
IF LRSS'="AU"
DO LEDI^LRVR0
+28 ;
+29 QUIT
+30 ;
+31 ;
UNRLSE ; Must unrelease at this point in order to successfully release below
+1 KILL LRFDA
+2 NEW LRREL,LRIENS3
+3 DO RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$GET(LRI))
+4 IF 'LRAU
Begin DoDot:1
+5 SET LRIENS3=LRI_","_LRDFN_","
+6 IF '$GET(LRREL(3))
SET LRFDA(LRSF,LRIENS3,.15)=LRREL(1)
+7 SET LRFDA(LRSF,LRIENS3,.11)="@"
+8 SET LRFDA(LRSF,LRIENS3,.13)="@"
End DoDot:1
+9 IF LRAU
Begin DoDot:1
+10 ;Must null this in order to prevent unrelease
SET LRZ(2)=""
+11 SET LRFDA(63,LRDFN,14.7)="@"
+12 SET LRFDA(63,LRDFN,14.8)="@"
End DoDot:1
+13 DO FILE^DIE("","LRFDA")
+14 QUIT
+15 ;
+16 ;
SUPCHK ; Check Supplementary Reports
+1 NEW LRSR,LRSR1,LRSR2,LRFILE,LRIENS,LRIENS1
+2 SET LRSR=0
SET LRSR1=1
+3 IF LRSS'="AU"
Begin DoDot:1
+4 if '+$PIECE($GET(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
QUIT
+5 SET LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
+6 SET LRIENS1=LRI_","_LRDFN_","
+7 FOR
SET LRSR=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,LRSR))
if LRSR'>0!('LRSR1)
QUIT
Begin DoDot:2
+8 SET LRIENS=LRSR_","_LRIENS1
+9 SET LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
+10 IF 'LRSR1
SET LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
End DoDot:2
End DoDot:1
+11 IF LRSS="AU"
Begin DoDot:1
+12 if '+$PIECE($GET(^LR(LRDFN,84,0)),U,4)
QUIT
+13 SET LRFILE=63.324
SET LRIENS1=LRDFN_","
+14 FOR
SET LRSR=$ORDER(^LR(LRDFN,84,LRSR))
if LRSR'>0!('LRSR1)
QUIT
Begin DoDot:2
+15 SET LRIENS=LRSR_","_LRIENS1
+16 SET LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
+17 IF 'LRSR1
SET LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
End DoDot:2
End DoDot:1
+18 IF 'LRSR1
Begin DoDot:1
+19 SET LRMSG="Supplementary report "_LRSR2_" has not been released. "
+20 SET LRMSG=LRMSG_"Cannot release."
+21 DO EN^DDIOL(LRMSG,"","!!")
KILL LRMSG
+22 SET LRQUIT=1
End DoDot:1
+23 QUIT
+24 ;
+25 ;
CKSIGNR ; Update supp report with Releaser ID and Date/time
+1 NEW LRIEN2,LRFLE,LRFL3
+2 SET LRQT2=0
+3 IF LRSS'="AU"
Begin DoDot:1
+4 SET (A,B)=0
FOR
SET A=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,A))
if 'A
QUIT
SET B=A
+5 IF '$DATA(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,B,0))
SET LRQT2=1
QUIT
+6 SET LRIEN2=B_","_LRDA_","_LRI_","_LRDFN_","
+7 SET LRFLE=$SELECT(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
+8 SET LRFL3=$SELECT(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
End DoDot:1
+9 IF LRSS="AU"
Begin DoDot:1
+10 SET (A,B)=0
FOR
SET A=$ORDER(^LR(LRDFN,84,LRDA,2,A))
if 'A
QUIT
SET B=A
+11 IF '$DATA(^LR(LRDFN,84,LRDA,2,B,0))
SET LRQT2=1
QUIT
+12 SET LRIEN2=B_","_LRDA_","_LRDFN_","
+13 SET LRFLE=$SELECT(LRSS="AU":63.3242,1:"")
+14 SET LRFL3=$SELECT(LRSS="AU":63.324,1:"")
End DoDot:1
+15 if LRQT2
QUIT
+16 SET LRFDA(LRFLE,LRIEN2,.03)=DUZ
+17 SET LRFDA(LRFLE,LRIEN2,.04)=$$NOW^XLFDT
+18 ; Must remove supp report modified flag once supp rpt is released
+19 SET LRFDA(LRFL3,LRIENS,.03)="@"
+20 ; Set, but don't file unless unrelease required
+21 SET LRFDA2(LRFLE,LRIEN2,.03)="@"
+22 SET LRFDA2(LRFLE,LRIEN2,.04)="@"
+23 QUIT
