Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRAPR1

LRAPR1.m

Go to the documentation of this file. 
  1. LRAPR1 ;VA/AVAMC/KLL- ANAT RELEASE REPORTS CONT'D;07/26/04
  1.  ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
  1.  ;;5.2;LAB SERVICE;**317**;Sep 27, 1994
  1.  ;
  1. RELCHK ;Check to make sure all supp reports are released
  1.  N LRFILE,LRIENS,LRIENS1,LRX,LRRLS,LRFDA,LRLKFL,LRDA,LRNOSP
  1.  N LRMSG,LRSRFL,LRSRMD
  1.  S DIC("B")=""
  1.  I LRSS'="AU" D
  1.  .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
  1.  .S LRIENS1=LRI_","_LRDFN_","
  1.  .S LRX=0 F  S LRX=$O(^LR(LRDFN,LRSS,LRI,1.2,LRX)) Q:'LRX  D
  1.  ..S LRIENS=LRX_","_LRIENS1
  1.  ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
  1.  ..;LRSRMD- if flag is true, supp rpt has been modified, needs release
  1.  ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
  1.  ..Q:LRSRFL&('LRSRMD)
  1.  ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
  1.  I LRSS="AU" D
  1.  .S LRFILE=63.324
  1.  .S LRX=0 F  S LRX=$O(^LR(LRDFN,84,LRX)) Q:'LRX  D
  1.  ..S LRIENS=LRX_","_LRDFN_","
  1.  ..S LRSRFL=$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
  1.  ..;LRSRMD- if flag is true, supp rpt has been modified, needs release
  1.  ..S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
  1.  ..Q:LRSRFL&('LRSRMD)
  1.  ..S DIC("B")=$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
  1.  I $G(DIC("B")) S LRQT=1
  1.  Q
  1. CHKSUP ;Check for unreleased supp reports for E-sign switch OFF
  1.  N LRQT,LRZ11,LRZ15,LRIENS3
  1.  S (LRQT,LRZ11,LRZ15)=0
  1.  D RELCHK
  1.  I LRQT D  Q
  1.  .W !!,"All supp repts must be released before main report can be released."
  1.  I 'LRQT D
  1.  .K LRFDA
  1.  .D NOW^%DTC S LRNTIME=%
  1.  .I 'LRAU D
  1.  ..S LRZ15=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",15)
  1.  ..S LRZ11=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",11)
  1.  ..S LRIENS3=LRI_","_LRDFN_","
  1.  ..S LRFDA(LRSF,LRIENS3,.11)=LRNTIME
  1.  ..S LRFDA(LRSF,LRIENS3,.13)=DUZ
  1.  ..I 'LRZ15 S LRFDA(LRSF,LRIENS3,.15)=LRZ11
  1.  .I LRAU D
  1.  ..S LRIENS3=LRDFN_","
  1.  ..S LRFDA(63,LRIENS3,14.7)=LRNTIME
  1.  ..S LRFDA(63,LRIENS3,14.8)=DUZ
  1.  .;S LRSRMD=$$GET1^DIQ(LRFILE,LRIENS,.03,"I")
  1.  .;If MODIFY SUPP REPORT flag is set, remove it at this point
  1.  .;I LRSRMD S LRFDA(LRSF,LRIENS,.03)="@"
  1.  .D FILE^DIE("","LRFDA")
  1.  .W !!,"*** Main Report Has Been Released ***",!
  1.  Q
  1. UNRLSE ;Must unrelease at this point in order to successfully release
  1.  ;  below
  1.  K LRFDA
  1.  N LRREL,LRIENS3
  1.  D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$G(LRI))
  1.  I 'LRAU D
  1.  .S LRIENS3=LRI_","_LRDFN_","
  1.  .I '$G(LRREL(3)) S LRFDA(LRSF,LRIENS3,.15)=LRREL(1)
  1.  .S LRFDA(LRSF,LRIENS3,.11)="@"
  1.  .S LRFDA(LRSF,LRIENS3,.13)="@"
  1.  I LRAU D
  1.  .S LRZ(2)="" ;Must null this in order to prevent unrelease
  1.  .S LRFDA(63,LRDFN,14.7)="@"
  1.  .S LRFDA(63,LRDFN,14.8)="@"
  1.  D FILE^DIE("","LRFDA")
  1.  Q
  1. SUPCHK  ;Check Supplementary Reports
  1.  N LRSR,LRSR1,LRSR2,LRFILE,LRIENS,LRIENS1
  1.  S LRSR=0,LRSR1=1
  1.  I LRSS'="AU" D
  1.  .Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
  1.  .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
  1.  .S LRIENS1=LRI_","_LRDFN_","
  1.  .F  S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1)  D
  1.  ..S LRIENS=LRSR_","_LRIENS1
  1.  ..S LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
  1.  ..I 'LRSR1 S LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
  1.  I LRSS="AU" D
  1.  .Q:'+$P($G(^LR(LRDFN,84,0)),U,4)
  1.  .S LRFILE=63.324,LRIENS1=LRDFN_","
  1.  .F  S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1)  D
  1.  ..S LRIENS=LRSR_","_LRIENS1
  1.  ..S LRSR1=+$$GET1^DIQ(LRFILE,LRIENS,.02,"I")
  1.  ..I 'LRSR1 S LRSR2=$$GET1^DIQ(LRFILE,LRIENS,.01)
  1.  I 'LRSR1 D
  1.  .S LRMSG="Supplementary report "_LRSR2_" has not been released.  "
  1.  .S LRMSG=LRMSG_"Cannot release."
  1.  .D EN^DDIOL(LRMSG,"","!!") K LRMSG
  1.  .S LRQUIT=1
  1.  Q
  1. CKSIGNR ;Update supp report with Releaser ID and Date/time
  1.  N LRIEN2,LRFLE,LRFL3
  1.  S LRQT2=0
  1.  I LRSS'="AU" D
  1.  .S (A,B)=0 F  S A=$O(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,A)) Q:'A  D
  1.  ..S B=A
  1.  .I '$D(^LR(LRDFN,LRSS,LRI,1.2,LRDA,2,B,0)) S LRQT2=1 Q
  1.  .S LRIEN2=B_","_LRDA_","_LRI_","_LRDFN_","
  1.  .S LRFLE=$S(LRSS="SP":63.8172,LRSS="CY":63.9072,LRSS="EM":63.2072,1:"")
  1.  .S LRFL3=$S(LRSS="SP":63.817,LRSS="CY":63.907,LRSS="EM":63.207,1:"")
  1.  I LRSS="AU" D
  1.  .S (A,B)=0 F  S A=$O(^LR(LRDFN,84,LRDA,2,A)) Q:'A  D
  1.  ..S B=A
  1.  .I '$D(^LR(LRDFN,84,LRDA,2,B,0)) S LRQT2=1 Q
  1.  .S LRIEN2=B_","_LRDA_","_LRDFN_","
  1.  .S LRFLE=$S(LRSS="AU":63.3242,1:"")
  1.  .S LRFL3=$S(LRSS="AU":63.324,1:"")
  1.  Q:LRQT2
  1.  S LRFDA(LRFLE,LRIEN2,.03)=DUZ
  1.  D NOW^%DTC
  1.  S LRFDA(LRFLE,LRIEN2,.04)=%
  1.  ;Must remove supp report modified flag once supp rpt is released
  1.  S LRFDA(LRFL3,LRIENS,.03)="@"
  1.  ;Set, but don't file unless unrelease required
  1.  S LRFDA2(LRFLE,LRIEN2,.03)="@"
  1.  S LRFDA2(LRFLE,LRIEN2,.04)="@"
  1.  Q