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

LRAPMRL1.m

Go to the documentation of this file. 
  1. LRAPMRL1 ;DALOI/STAFF - AP MODIFY RELEASED REPORT CONT'D ;11/04/11  10:47
  1.  ;;5.2;LAB SERVICE;**259,317,397,350**;Sep 27, 1994;Build 230
  1.  ;
  1.  Q
  1. RELCHK ; Perform series of checks
  1.  N RPCOMDT
  1.  S LRQUIT=0
  1.  I LRAU,$G(^LR(LRDFN,"AU"))="" D  Q
  1.  . S LRMSG="No information found for this accession in the "
  1.  . S LRMSG=LRMSG_"LAB DATA file (#63)."
  1.  . D EN^DDIOL(LRMSG,"","!!") K LRMSG
  1.  . S LRQUIT=1
  1.  Q:LRQUIT
  1.  K LRREL
  1.  D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$G(LRI))
  1.  I 'LRREL(1) D
  1.  . Q:'LRAU&($G(LRREL(3)))
  1.  . ;KLL-SKIP THIS MSG IF AU RPT COMP DATE IS SET
  1.  . S RPCOMDT=$$GET1^DIQ(63,LRDFN,13,"I")
  1.  . Q:LRAU&($G(RPCOMDT))
  1.  . S LRMSG=$C(7)_"Report has not been released.  Do not use this "
  1.  . S LRMSG=LRMSG_"option."
  1.  . D EN^DDIOL(LRMSG,"","!!") K LRMSG
  1.  . S LRQUIT=1
  1.  ; Has a supplemental rept been entered, but not yet released? Don't allow modifications until supplemental rept. is released.
  1.  N LRSR,LRSR1,LRSR2
  1.  S LRSR=0,LRSR1=1
  1.  I LRREL(1),'LRAU D 
  1.  . Q:'+$P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
  1.  . F  S LRSR=$O(^LR(LRDFN,LRSS,LRI,1.2,LRSR)) Q:LRSR'>0!('LRSR1)  D
  1.  . . S LRSR1=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U,2)
  1.  . . I 'LRSR1 D
  1.  . . . S Y=+$P(^LR(LRDFN,LRSS,LRI,1.2,LRSR,0),U)
  1.  . . . D DD^%DT S LRSR2=Y
  1.  I LRREL(1),LRAU D
  1.  . S RPCOMDT=$$GET1^DIQ(63,LRDFN,13,"I")
  1.  . Q:'RPCOMDT
  1.  . Q:'+$P($G(^LR(LRDFN,84,0)),U,4)
  1.  . F  S LRSR=$O(^LR(LRDFN,84,LRSR)) Q:LRSR'>0!('LRSR1)  D
  1.  . . S LRSR1=+$P(^LR(LRDFN,84,LRSR,0),U,2)
  1.  . . I 'LRSR1 D
  1.  . . . S Y=+$P(^LR(LRDFN,84,LRSR,0),U)
  1.  . . . D DD^%DT S LRSR2=Y
  1.  I 'LRSR1 D
  1.  . S LRQUIT=1
  1.  . W $C(7),!,"Supplementary report "_LRSR2_" has not been released.  "
  1.  . W !,"Cannot modify the report."
  1.  . S Y=0
  1.  Q
  1.  ;
  1.  ;
  1. RELEASE ; Unrelease report
  1.  N LRNTIME,RPCOMDT
  1.  D NOW^%DTC S LRNTIME=%
  1.  K LRFDA
  1.  I 'LRAU D
  1.  . I '$G(LRREL(3)) S LRFDA(LRSF,LRIENS,.15)=LRREL(1)
  1.  . S LRFDA(LRSF,LRIENS,.11)="@"
  1.  . S LRFDA(LRSF,LRIENS,.13)="@"
  1.  . S LRFDA(LRSF,LRIENS,.17)=LRNTIME
  1.  . S LRFDA(LRSF,LRIENS,.171)=DUZ
  1.  I LRAU D
  1.  . S LRFDA(63,LRIENS,14.7)="@"
  1.  . S LRFDA(63,LRIENS,14.8)="@"
  1.  . ;KLL-ONLY IF REPT COMP DATE IS SET,OK TO MARK AS MODIFIED
  1.  . S RPCOMDT=$$GET1^DIQ(63,LRIENS,13,"I")
  1.  . I RPCOMDT D
  1.  . . S LRFDA(63,LRIENS,102)=LRNTIME
  1.  . . S LRFDA(63,LRIENS,102.1)=DUZ
  1.  D FILE^DIE("","LRFDA")
  1.  Q
  1.  ;
  1.  ;
  1. QUEUPD ;Update the final report print queue
  1.  I '$D(^LRO(69.2,LRAA,2,LRAN,0)) D
  1.  . K LRFDA
  1.  . L +^LRO(69.2,LRAA,2):DILOCKTM I '$T D  Q
  1.  . . S MSG(1)="The final reports queue is in use by another person.  "
  1.  . . S MSG(1,"F")="!!"
  1.  . . S MSG(2)="You will need to add this accession to the queue later."
  1.  . . D EN^DDIOL(.MSG) K MSG
  1.  . S LRIENS="+1,"_LRAA_","
  1.  . S LRFDA(69.23,LRIENS,.01)=LRDFN
  1.  . S LRFDA(69.23,LRIENS,1)=LRI
  1.  . S LRFDA(69.23,LRIENS,2)=LRH(0)
  1.  . S LRORIEN(1)=LRAN
  1.  . D UPDATE^DIE("","LRFDA","LRORIEN") K LRORIEN
  1.  . L -^LRO(69.2,LRAA,2)
  1.  Q
  1.  ;
  1.  ;
  1. EDIT ;
  1.  W !
  1.  I 'LRAU S DA=LRI,DA(1)=LRDFN,DIE="^LR("_LRDFN_","""_LRSS_""","
  1.  S:LRAU DIE="^LR(",DA=LRDFN
  1.  D ^DIE
  1.  S:$D(Y) LRQUIT=1
  1.  S:$G(DTOUT) LRQUIT=1
  1.  Q
  1.  ;
  1.  ;
  1. SETDR ; Set the DR string
  1.  I LRAU D
  1.  . K DR
  1.  . S DR="13;13.01///^S X=LRWHO;32.1;99;11;14.1;14.5;14.6;12.1;"
  1.  . S DR=DR_"13.5;13.6;13.8;32;80;"
  1.  . S:LRWM DR=DR_"16:24;26:31;25;31.1;31.4;25.1;25.9"
  1.  . S DR(2,63.2)=".01;I 'LREFPD S Y=4;1;1.5;3;4;5"
  1.  . S DR(3,63.21)=".01",DR(3,63.22)=".01;I 'LREFPD S Y=0;1"
  1.  . S DR(3,63.24)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
  1.  . S DR(4,63.23)=".01"
  1.  I 'LRAU D
  1.  . S LRV=+$P($G(^LRO(69.2,LRAA,0)),U,10)  ;Ask TC codes?
  1.  . K DR
  1.  . S DR=".08;.07;.011;.012;.013;.014;.015;.016;.1;.02;.021;.99;.97;"
  1.  . S DR=DR_"10;80;.09///^S X=LRWHO;.03"
  1.  . I LRSS="SP" D
  1.  . . S DR(2,63.12)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
  1.  . . S DR(2,63.12)=DR(2,63.12)_"I 'LREFPD S Y=5;1;1.5;3;5"
  1.  . .S DR(2,63.812)=".01;.06R;.07R"
  1.  . . S DR(3,63.16)=".01;I 'LREFPD S Y=0;1"
  1.  . . S DR(3,63.82)=".01;D R^LRAPD;.02"
  1.  . I LRSS="CY" D
  1.  . . S DR(2,63.902)=".01;.02;.06R;.07R"
  1.  . . S DR(2,63.912)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
  1.  . . S DR(2,63.912)=DR(2,63.912)_"I 'LREFPD S Y=5;1;1.5;3;5"
  1.  . . S DR(3,63.916)=".01;I 'LREFPD S Y=0;1"
  1.  . . S DR(3,63.982)=".01;D R^LRAPD;.02"
  1.  . I LRSS="EM" D
  1.  . . S DR(2,63.202)=".01;.06R;.07R"
  1.  . . S DR(2,63.212)=".01;S LR(8)=$P(^LAB(61,X,0),U,4);S:'LR(8) Y=4;2;4;"
  1.  . . S DR(2,63.212)=DR(2,63.212)_"I 'LREFPD S Y=5;1;1.5;3;5"
  1.  . . S DR(3,63.216)=".01;I 'LREFPD S Y=0;1"
  1.  . . S DR(3,63.282)=".01;S:'$P(^LAB(61.5,X,0),U,3) Y=0;.02"
  1.  Q
  1.  ;
  1.  ;
  1. CPTCODE ; Enter CPT codes
  1.  K DIR
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="Enter CPT CODING"
  1.  D ^DIR
  1.  I Y="^"!(Y<1) S LRQUIT=1 Q
  1.  N LRPRO
  1.  ; SET PROVIDER=CURRENT USER, ALLOW UPDATES
  1.  S LRPRO=DUZ
  1.  D PROVIDR^LRAPUTL
  1.  Q:LRQUIT
  1.  D CPT^LRCAPES(LRAA,LRAD,LRAN,LRPRO)
  1.  Q