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

LRCAPL1.m

Go to the documentation of this file. 
  1. LRCAPL1 ;SLC/DCM- CAP STATISTICS BY LOCATION SORT ; 2/6/89  12:15 ;
  1.  ;;V~5.0~;LAB;;02/27/90 17:09
  1.  K ^UTILITY($J) W !,"...HOLD ON, JUST A MOMENT PLEASE..."
  1. II F II=0:0 S II=$N(^LAM(II)) Q:II<1  S X=^(II,0),LRT=$P(X,"^",1),LRUW=$P(X,"^",3),LRM=$P(X,"^",4),LRS=$P(X,"^",8),LRSB=$P(X,"^",9) D CHECK^LRCAPS1 I LRCHECK D:LRALL JJ D:'LRALL LRA
  1.  K LRT,LRUW,LRM,LRS,LRSB,LRCHECK,II,IIN
  1.  Q
  1. JJ F JJ=0:0 S JJ=$N(^LAM(II,1,JJ)) Q:JJ<1  D DATES
  1.  Q
  1. LRA F JJ=0:0 S JJ=$N(LRA(JJ)) Q:JJ<1  Q:'$D(^LAM(II,1,JJ))  D DATES
  1.  Q
  1. DATES F KK=LRFDT:0 S KK=$N(^LAM(II,1,JJ,1,KK)) Q:KK<1!(KK>LRLDT)  D LOC
  1.  Q
  1. LOC F LL=0:0 S LL=$N(^LAM(II,1,JJ,1,KK,1,LL)) Q:LL<1  S L1=^(LL,0) D COUNT,UTL
  1.  Q
  1. COUNT S S1=$S($D(^LAM(II,1,JJ,1,KK,1,LL,1)):^(1),1:0),S3=$S($D(^(3)):^(3),1:0)
  1.  Q
  1. UTL I '$L(LRS) W !,"MISSING SECTION IN FILE 64 FOR ",LRT,!,"Use the LRCAPE1 option to add missing information so that test can be included." Q
  1.  S IIN=$P(^LAM(II,0),U) I $D(^UTILITY($J,JJ,LRM,L1,LRS,IIN)) S X=^(IIN),S1=$P(X,"^",2)+S1,S3=$P(X,"^",3)+S3
  1.  S ^UTILITY($J,JJ,LRM,L1,LRS,IIN)=LRUW_"^"_S1_"^"_S3
  1.  Q