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

QAMC21.m

Go to the documentation of this file.
QAMC21 ;HISC/DAD-CONDITION: LAB-CHEM,HEM,TOX,RIA,SER,ETC ;5/20/93  13:17
 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** CONDITION CODE
 S QAMLRTST=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:^("P1"),1:"")
 S QAM0=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:^("P2"),1:"")
 S QAM1=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P3"))#2:^("P3"),1:"")
 F QAMLRVDT=QAMTODAY-.0000001:0 S QAMLRVDT=$O(^LRO(69,QAMLRVDT)) Q:(QAMLRVDT'>0)!(QAMLRVDT>(QAMTODAY+.9999999))  S QAMLRLOC="" F QAMLRLOC(0)=0:0 S QAMLRLOC=$O(^LRO(69,QAMLRVDT,1,"AN",QAMLRLOC)) Q:QAMLRLOC=""  D LOOP1
 K QAM0,QAM1,QAMDD,QAMDDFLD,QAMDDTYP,QAMLABD0,QAMLABD1,QAMLABDD,QAMLABGL,QAMLABST,QAMLRDAT,QAMLRDFN,QAMLRGLB,QAMLRIDT,QAMLRLOC,QAMLRTST,QAMLRVDT
 Q
LOOP1 F QAMLRDFN=0:0 S QAMLRDFN=$O(^LRO(69,QAMLRVDT,1,"AN",QAMLRLOC,QAMLRDFN)) Q:QAMLRDFN'>0  F QAMLRIDT=0:0 S QAMLRIDT=$O(^LRO(69,QAMLRVDT,1,"AN",QAMLRLOC,QAMLRDFN,QAMLRIDT)) Q:QAMLRIDT'>0  D LOOP2
 Q
LOOP2 S QAMDFN=$S($D(^LR(QAMLRDFN,0))#2:^(0),1:"") Q:$P(QAMDFN,"^",2)'=2  S QAMDFN=+$P(QAMDFN,"^",3) Q:$D(^DPT(QAMDFN,0))[0
 Q:$D(^LR(QAMLRDFN,"CH",QAMLRIDT,0))[0
 S QAMLRGLB=$P(QAMLRTST,"^",4,999) Q:QAMLRGLB=""
 S QAMLABD0=QAMLRDFN,QAMLABD1=QAMLRIDT,QA="QAMLRDAT="_QAMLRGLB,@QA
 Q:QAMLRDAT=""  S QAMTYPE=$P(QAMLRTST,"^",3)
 I QAMTYPE="S",QAMLRDAT=QAM0 D SET Q  ;                   SET OF CODES
 I QAMTYPE="F",QAMLRDAT[QAM0 D SET Q  ;                   FREE TEXT
 S QAMLRDAT=$TR(QAMLRDAT,$TR(QAMLRDAT,"-.0123456789")) ;  NUMRIC 
 I $E(QAMLRDAT,$L(QAMLRDAT))="." S QAMLRDAT=$E(QAMLRDAT,1,$L(QAMLRDAT)-1)
 I QAMLRDAT?.N.1"."1.N,QAMLRDAT'<QAM0,QAMLRDAT'>QAM1 D SET ; NUMERIC
 Q
SET S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN)="",^(QAMDFN,9999999-QAMLRIDT)=QAMLRDFN_"^"_QAMLRIDT
 Q
EN2 ; *** PARAMETER CODE
 K DIC,DIR,DIRUT S DIC=60,DIC(0)="EMNQZ",DIC("S")="S QA=^(0) I $P(QA,""^"",4)=""CH"",$P(QA,""^"",12)]"""""
 S DIC("A")="LAB TEST: ",DIC("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:$P(^("P1"),"^",2),1:"") K:DIC("B")="" DIC("B")
 S DIR("?")="Enter the name of an individual lab test whose result you want to monitor."
 S QAMPARAM="P1" D EN2^QAMUTL1 I ($D(DIRUT))!(Y="") S Y=-1 G Y
 S QAMDD(0)=$P(Y(0),"^",12),QAMDD=$P(QAMDD(0),"DD(",2),QAMLABDD=@("^"_QAMDD(0)_"0)"),QAMDDFLD=$P(QAMLABDD,"^"),QAMDDTYP=$E($P(QAMLABDD,"^",2))
 S QAMLABGL=$P(QAMLABDD,"^",4),QA="$P($G(^LR(QAMLABD0,""CH"",QAMLABD1,"_$P(QAMLABGL,";")_")),""^"","_+$P(QAMLABGL,";",2)_")"
 S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y_"^"_Y(0,0)_"^"_QAMDDTYP_"^"_QA ; LAB TEST IEN ^ LAB TEST NAME ^ LAB TEST DATA TYPE ^ GLOBAL LOCATION
START ;
 K DIR S DIR("A")=$S(QAMDDTYP="N":"STARTING VALUE ",1:"")_QAMDDFLD,DIR(0)=+QAMDD_","_+$P(QAMDD,",",2),DIR("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:$P(^("P2"),"^"),1:"") K:DIR("B")="" DIR("B")
 S QAMPARAM="P2" D EN3^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
 S ^QA(743,QAMD0,"COND",QAMD1,"P2")=$S(QAMDDTYP="S":Y_"^"_Y(0),1:Y) S QAMLABST=Y
 G:QAMDDTYP'="N" EXIT
END ;
 K DIR S DIR("A")="ENDING VALUE "_QAMDDFLD,DIR(0)=+QAMDD_","_+$P(QAMDD,",",2),DIR("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P3"))#2:$P(^("P3"),"^"),1:"") K:DIR("B")="" DIR("B")
 S QAMPARAM="P3" D EN3^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
 I QAMLABST>Y W *7,!!?5,"*** Ending value must be greater than or equal to the starting value ***",!,*7 G START
 S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P3")=Y
EXIT K Y
Y Q