LRAPR1 ;VA/AVAMC/KLL- ANAT RELEASE REPORTS CONT'D;07/26/04
;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
;;5.2;LAB SERVICE;**317**;Sep 27, 1994
;
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
.D NOW^%DTC S LRNTIME=%
.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 ***",!
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 D
..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 D
..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
D NOW^%DTC
S LRFDA(LRFLE,LRIEN2,.04)=%
;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
LRAPR1 ;VA/AVAMC/KLL- ANAT RELEASE REPORTS CONT'D;07/26/04
+1 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
+2 ;;5.2;LAB SERVICE;**317**;Sep 27, 1994
+3 ;
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
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 DO NOW^%DTC
SET LRNTIME=%
+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 QUIT
UNRLSE ;Must unrelease at this point in order to successfully release
+1 ; below
+2 KILL LRFDA
+3 NEW LRREL,LRIENS3
+4 DO RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$GET(LRI))
+5 IF 'LRAU
Begin DoDot:1
+6 SET LRIENS3=LRI_","_LRDFN_","
+7 IF '$GET(LRREL(3))
SET LRFDA(LRSF,LRIENS3,.15)=LRREL(1)
+8 SET LRFDA(LRSF,LRIENS3,.11)="@"
+9 SET LRFDA(LRSF,LRIENS3,.13)="@"
End DoDot:1
+10 IF LRAU
Begin DoDot:1
+11 ;Must null this in order to prevent unrelease
SET LRZ(2)=""
+12 SET LRFDA(63,LRDFN,14.7)="@"
+13 SET LRFDA(63,LRDFN,14.8)="@"
End DoDot:1
+14 DO FILE^DIE("","LRFDA")
+15 QUIT
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
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
Begin DoDot:2
+5 SET B=A
End DoDot:2
+6 IF '$DATA(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,B,0))
SET LRQT2=1
QUIT
+7 SET LRIEN2=B_","_LRDA_","_LRI_","_LRDFN_","
+8 SET LRFLE=$SELECT(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
+9 SET LRFL3=$SELECT(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
End DoDot:1
+10 IF LRSS="AU"
Begin DoDot:1
+11 SET (A,B)=0
FOR
SET A=$ORDER(^LR(LRDFN,84,LRDA,2,A))
IF 'A
QUIT
Begin DoDot:2
+12 SET B=A
End DoDot:2
+13 IF '$DATA(^LR(LRDFN,84,LRDA,2,B,0))
SET LRQT2=1
QUIT
+14 SET LRIEN2=B_","_LRDA_","_LRDFN_","
+15 SET LRFLE=$SELECT(LRSS="AU":63.3242,1:"")
+16 SET LRFL3=$SELECT(LRSS="AU":63.324,1:"")
End DoDot:1
+17 IF LRQT2
QUIT
+18 SET LRFDA(LRFLE,LRIEN2,.03)=DUZ
+19 DO NOW^%DTC
+20 SET LRFDA(LRFLE,LRIEN2,.04)=%
+21 ;Must remove supp report modified flag once supp rpt is released
+22 SET LRFDA(LRFL3,LRIENS,.03)="@"
+23 ;Set, but don't file unless unrelease required
+24 SET LRFDA2(LRFLE,LRIEN2,.03)="@"
+25 SET LRFDA2(LRFLE,LRIEN2,.04)="@"
+26 QUIT
