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

LRAPM.m

Go to the documentation of this file. 
  1. LRAPM ;AVAMC/REG/WTY - ANATOMIC PATH MODIFY MICRO/DX ;10/23/04  22:55
  1.  ;;5.2;LAB SERVICE;**1002,1030,1031**;NOV 01, 1997
  1.  ;
  1.  ;;VA LR Patch(s): 72,91,130,231,248,295
  1.  ;
  1.  ;Reference to ^%DT supported by IA #10003
  1.  ;Reference to %XY^%RCR supported by IA #10022
  1.  ;Reference to ^DIE supported by IA #10018
  1.  ;Reference to EN^DDIOL supported by IA #10142
  1.  ;
  1.  D A^LRAPD Q:'$D(Y)
  1.  I LRCAPA D @(LRSS_"^LRAPSWK")
  1.  D @LRSS
  1.  S LRB(1)="GROSS DESCRIPTION",LRB(2)="MICROSCOPIC DESCRIPTION"
  1.  S LRB(3)="DIAGNOSIS",LRB(4)="FROZEN SECTION"
  1.  S:'$D(^LRO(69.2,LRAA,2,0)) ^(0)="^69.23A^^"
  1. AK W !!,"Modify data for ",LRH(0)," "
  1.  S %=1 D YN^LRU G:%<1 END
  1.  I %=2 S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: " D ^%DT K %DT G:Y<1 END S LRAD=$E(Y,1,3)_"0000",LRH(0)=$E(Y,1,3)+1700
  1.  I '$D(^LRO(68,LRAA,1,LRAD,0)) W $C(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!! G END
  1. W K X,Y R !!,"Select Accession Number/Pt name: ",LRAN:DTIME
  1.  G:LRAN=""!(LRAN[U) END
  1.  I LRAN'?1N.N D PNAME^LRAPDA G:LRAN<1 W D DIE G W
  1.  D REST G W
  1. REST W "  for ",LRH(0) I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)," not in ACCESSION file",!! Q
  1.  S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X
  1.  Q:'$D(^LR(LRDFN,0))  S X=^(0) D ^LRUP
  1.  ; W !,LRP,"  ID: ",SSN
  1.  W !,LRP,"  ID: ",HRCN  ; IHS/ANMC/CLS 08/18/96 -- LR*5.2*1030
  1.  S LRI=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5)
  1.  W:$O(^LR(LRDFN,LRSS,LRI,.1,0)) !,"Specimen(s):" F X=0:0 S X=$O(^LR(LRDFN,LRSS,LRI,.1,X)) Q:'X  W !,$P($G(^(X,0)),U)
  1. DIE S X=^LR(LRDFN,LRSS,LRI,0)
  1.  I '$P(X,"^",11),'$P(X,"^",15) W $C(7),!!,"Report not verified.  Do not need to use this option !" Q
  1. ASK D:LRCAPA C^LRAPSWK
  1.  W !?14,"1. MODIFY GROSS DESCRIPTION",!?14,"2. MODIFY MICROSCOPIC DESCRIPTION",!?14,"3. MODIFY DIAGNOSIS" S LRB=3 I LRSS="SP" W !?14,"4. MODIFY FROZEN SECTION" S LRB=4
  1.  W !,"CHOOSE (1-",LRB,"): " R X:DTIME Q:X[U!(X="")
  1.  I X'=+X!(X<1)!(X>LRB) W $C(7),!,"Choose from 1 to ",LRB G ASK
  1.  S LRB=X,LRF=$S(X=1:"1^7",X=2:"1.1^4",X=3:"1.4^5",1:"1.3^6"),LRE=$P(LRF,U,2),LRF=$P(LRF,U)
  1.  I '$D(^LR(LRDFN,LRSS,LRI,LRF)) W $C(7),!!,"There is no ",LRB(LRB)," text to modify !",!,"The report was released before entering text.",!,"Do you still want to continue " S %=2 D YN^LRU Q:%'=1  G A
  1.  W !!,"Are you sure you want to modify ",LRB(LRB)," text " S %=2 D YN^LRU Q:%'=1
  1. A S:'$D(^LR(LRDFN,LRSS,LRI,LRE,0)) ^(0)=LRQ(LRB) S LRT(1)=^(0),(B,C)=0
  1.  F A=0:1 S B=$O(^LR(LRDFN,LRSS,LRI,LRE,B)) Q:'B  S C=B
  1.  S C=C+1
  1.  S ^LR(LRDFN,LRSS,LRI,LRE,0)=$P(LRT(1),"^",1,2)_"^"_C_"^"_($P(LRT(1),"^",4)+1),LRDTMOD=C
  1.  S X="N",%DT="T" D ^%DT
  1.  S ^LR(LRDFN,LRSS,LRI,LRE,LRDTMOD,0)=Y_"^"_DUZ
  1.  S %X="^LR(LRDFN,LRSS,LRI,LRF,",%Y="^LR(LRDFN,LRSS,LRI,LRE,LRDTMOD,1,"
  1.  D %XY^%RCR
  1.  W ! S DR=LRF,DIE="^LR(LRDFN,LRSS,",DA=LRI,DA(1)=LRDFN
  1.  I LRF=1 D
  1.  .S DR=".012;1"
  1.  .S:LRSS="SP" DR(2,63.812)=".01"
  1.  .S:LRSS="CY" DR(2,63.902)=".01;.02"
  1.  .S:LRSS="EM" DR(2,63.202)=".01"
  1.  L +^LR(LRDFN,LRSS,DA):5 I '$T D  Q
  1.  .S MSG="This record is locked by another user.  "
  1.  .S MSG=MSG_"Please try again later."
  1.  .D EN^DDIOL(MSG,"","!!") K MSG
  1.  D ^DIE S X=^LR(LRDFN,LRSS,LRI,0),LRRC=$P(X,"^",10) K X
  1.  L -^LR(LRDFN,LRSS,DA)
  1.  D:LRCAPA C1^LRAPSWK
  1.  S LRC=1 F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,LRF,A)) Q:'A  S X=^(A,0) S:'$D(^LR(LRDFN,LRSS,LRI,LRE,LRDTMOD,1,A,0)) LRC=0 Q:'LRC  I X'=^(0) S LRC=0 Q
  1.  I LRC F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,LRE,LRDTMOD,1,A)) Q:'A  S X=^(A,0) I '$D(^LR(LRDFN,LRSS,LRI,LRF,A,0)) S LRC=0 Q
  1.  I LRC D  Q
  1.  . W $C(7),!!,"No changes were made to ",LRB(LRB)
  1.  . K ^LR(LRDFN,LRSS,LRI,LRE,LRDTMOD)
  1.  . S X=^LR(LRDFN,LRSS,LRI,LRE,0),A=$P(X,"^",4),Y=$O(^(0))
  1.  . S ^LR(LRDFN,LRSS,LRI,LRE,0)=$P(X,"^",1,2)_"^"_Y_"^"_$S(A:A-1,1:0)
  1.  S X=^LR(LRDFN,LRSS,LRI,0),Y=$P(X,"^",15),$P(^(0),"^",11)="" S:'Y $P(^(0),"^",15)=$P(X,"^",11)
  1.  I $G(SEX)["F","SPCY"[LRSS D DEL^LRWOMEN ;This sends notificatin to WHP
  1.  ;that a previously verified report has been modified. ;cym 2/20/1999
  1.  ; D UPDATE^LRPXRM(LRDFN,LRSS,LRI)     ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
  1.  I $$PATCH^BLRUTIL4("PXRM*1.5*12") D UPDATE^LRPXRM(LRDFN,LRSS,+$G(LRI))     ; IHS/MSC/MKK - LR*5.2*1031
  1.  I '$D(^LRO(69.2,LRAA,2,LRAN,0)) D
  1.  .L +^LRO(69.2,LRAA,2):5 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 ^LRO(69.2,LRAA,2,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0)
  1.  .S X=^LRO(69.2,LRAA,2,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1)
  1.  .L -^LRO(69.2,LRAA,2)
  1.  Q
  1. SP S LRQ(1)="^63.087DA^^",LRQ(2)="^63.84DA^^",LRQ(3)="^63.085DA^^",LRQ(4)="^63.086DA^^" Q
  1. CY S LRQ(1)="^63.097D^^",LRQ(2)="^63.94DA^^",LRQ(3)="^63.095DA^^" Q
  1. EM S LRQ(1)="^63.0272DA^^",LRQ(2)="^63.242DA^^",LRQ(3)="^63.025DA^^" Q
  1.  ;
  1. END D V^LRU K LRDTMOD Q