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

LRCAP.m

Go to the documentation of this file. 
  1. LRCAP ;SLC/CJS- STUFF AMIS/CAP DATA INTO LAM GLOBAL ;9/1/89  15:29 ;
  1.  ;;V~5.0~;LAB;**44**;02/27/90 17:09
  1.  Q:'$D(^LR(LRDFN,LRSS,LRIDT,0))  S:'$P(LRPARAM,U,15) Z=1
  1.  I $P(LRPARAM,U,15) S Z=0 F II=0:0 S II=$N(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II)) Q:II<1  I $P(^LAB(60,II,0),"^",2),$O(^LAB(60,II,9,0)) S Z=1 Q
  1.  I 'Z Q
  1.  S Y=^LR(LRDFN,LRSS,LRIDT,0) S:$D(X) LRXXX=X
  1.  K LRA
  1.  W !,"Change or exclude any tests from workload reporting" S %=2 D YN^DICN
  1.  I %=1,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,"AE")) W *7,!!,"This accession has already been processed into the AMIS/CAP file.",!,"You will need to use the MANUAL EDIT CAP option to make any changes." Q
  1.  D NEWCAP:%=1
  1.  K X,%,LRLN,LRSUF,LRSITE,LRA,LRT,LRF,LRI,LRY
  1.  S:$D(LRXXX) X=LRXXX K LRXXX Q
  1. NEWCAP S LRCAPUD=1,LRF=0 W @IOF,!,"Listed below are the tests on this accession.",!,"Select the test for which you want to change the AMIS/CAP code."
  1.  K LRR S LRF=0 W !!?5,"TEST NAME",!?5,"---------"
  1.  I '$D(LRMX) F I=0:0 S I=$N(LRNAME(I)) Q:I<1  S II=$N(LRNAME(I,0)),LRMX(II)=""
  1.  I '$D(LRMX) F I=0:0 S I=$N(LRM(I)) Q:I<1  S LRMX(LRM(I))=""
  1.  F I=0:0 S I=$O(LRTEST(I)) Q:I=""!(LRF)  S LRMX($P(LRTEST(I),U))=""
  1.  F LRZZ=1:1 Q:LRF  D TESTS K DIC
  1.  I LRF,'Z K LRMX Q
  1.  W @IOF,!,"You have selected the following AMIS/CAP codes for this accession: "
  1.  W !!?5,"TEST NAME",?30,"AMIS/CAP CODE",!?5,"---------",?30,"-------------"
  1.  F II=0:0 S II=$N(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II)) Q:II<1  I $P(^(II,0),U,5),$P(^LAB(60,+^(0),0),U,2) S II1=$P(^(0),U) W !?5,II1 S J=0 D JJ
  1.  S %=1 W !!,"ALL OK" D YN^DICN I %=2 G NEWCAP
  1.  K LRMX Q
  1. TESTS K DIC D II
  1.  K DIC,DIE,DR,DA,LRR,II,II1,JJ,J,LRSY,LRO,LRA,LRI,LRJ,LRX1,LRIX
  1.  Q
  1. II S Z=0 F II=0:0 S II=$N(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II)) Q:II<1  I $P(^(II,0),U,5),$P(^LAB(60,II,0),U,2) W !?5,$P(^(0),U) S Z=1
  1.  I 'Z W !!,*7,?5,"There are not any AMIS/CAP for this Order Number",! S LRF=1 Q
  1.  S X1=$N(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)),X=$S(X1>0:$P(^LAB(60,X1,0),"^",1),1:""),DA(4)=LRAA,DA(3)=LRAD,DA(2)=LRAN,DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"_LRAN_",4,",DIC(0)="AEMNOQ"
  1.  I $L(X),'$D(^LAB(60,X1,9)) S X=""
  1.  S DIC("A")="Select ACCESSION TEST: ",DIC("S")="I $P(^(0),U,5),$P(^LAB(60,+Y,0),U,2)" D ^DIC I +Y<0 S LRF=1 Q
  1.  S LRSY=+Y
  1.  I '$D(^LAB(60,LRSY,9)) W !!,"There are no AMIS/CAP codes setup for this test in file 60.",!,*7 S LRZZ=LRZZ+1 K DIC("B") G II
  1.  S LRO=0 D A^LRCAP2 Q
  1. JJ F JJ=0:0 S JJ=$N(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II,1,JJ)) Q:JJ<1  S J=J+1 W:J>1 ! W ?30,$P(^LAM($P(^(JJ,0),U,1),0),U,1),"  ",$P(^(0),U,2) I $Y>21 R !,"Press return to continue...",X:DTIME W @IOF
  1.  Q
  1. CLEAN F I=0:0 S I=$N(^LRO(68,I)) Q:I<1  F J=0:0 S J=$N(^LRO(68,I,1,J)) Q:J<1  F K=0:0 S K=$N(^LRO(68,I,1,J,1,K)) Q:K<1  K ^(K,"AE")
  1.  F I=0:0 S I=$N(^LAM(I)) Q:I<1  F J=0:0 S J=$N(^LAM(I,1,J)) Q:J<1  K ^(J)
  1.  Q