source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMC21.m@ 767

Last change on this file since 767 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1QAMC21 ;HISC/DAD-CONDITION: LAB-CHEM,HEM,TOX,RIA,SER,ETC ;5/20/93 13:17
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3EN1 ; *** CONDITION CODE
4 S QAMLRTST=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:^("P1"),1:"")
5 S QAM0=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:^("P2"),1:"")
6 S QAM1=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P3"))#2:^("P3"),1:"")
7 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
8 K QAM0,QAM1,QAMDD,QAMDDFLD,QAMDDTYP,QAMLABD0,QAMLABD1,QAMLABDD,QAMLABGL,QAMLABST,QAMLRDAT,QAMLRDFN,QAMLRGLB,QAMLRIDT,QAMLRLOC,QAMLRTST,QAMLRVDT
9 Q
10LOOP1 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
11 Q
12LOOP2 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
13 Q:$D(^LR(QAMLRDFN,"CH",QAMLRIDT,0))[0
14 S QAMLRGLB=$P(QAMLRTST,"^",4,999) Q:QAMLRGLB=""
15 S QAMLABD0=QAMLRDFN,QAMLABD1=QAMLRIDT,QA="QAMLRDAT="_QAMLRGLB,@QA
16 Q:QAMLRDAT="" S QAMTYPE=$P(QAMLRTST,"^",3)
17 I QAMTYPE="S",QAMLRDAT=QAM0 D SET Q ; SET OF CODES
18 I QAMTYPE="F",QAMLRDAT[QAM0 D SET Q ; FREE TEXT
19 S QAMLRDAT=$TR(QAMLRDAT,$TR(QAMLRDAT,"-.0123456789")) ; NUMRIC
20 I $E(QAMLRDAT,$L(QAMLRDAT))="." S QAMLRDAT=$E(QAMLRDAT,1,$L(QAMLRDAT)-1)
21 I QAMLRDAT?.N.1"."1.N,QAMLRDAT'<QAM0,QAMLRDAT'>QAM1 D SET ; NUMERIC
22 Q
23SET S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN)="",^(QAMDFN,9999999-QAMLRIDT)=QAMLRDFN_"^"_QAMLRIDT
24 Q
25EN2 ; *** PARAMETER CODE
26 K DIC,DIR,DIRUT S DIC=60,DIC(0)="EMNQZ",DIC("S")="S QA=^(0) I $P(QA,""^"",4)=""CH"",$P(QA,""^"",12)]"""""
27 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")
28 S DIR("?")="Enter the name of an individual lab test whose result you want to monitor."
29 S QAMPARAM="P1" D EN2^QAMUTL1 I ($D(DIRUT))!(Y="") S Y=-1 G Y
30 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))
31 S QAMLABGL=$P(QAMLABDD,"^",4),QA="$P($G(^LR(QAMLABD0,""CH"",QAMLABD1,"_$P(QAMLABGL,";")_")),""^"","_+$P(QAMLABGL,";",2)_")"
32 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
33START ;
34 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")
35 S QAMPARAM="P2" D EN3^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
36 S ^QA(743,QAMD0,"COND",QAMD1,"P2")=$S(QAMDDTYP="S":Y_"^"_Y(0),1:Y) S QAMLABST=Y
37 G:QAMDDTYP'="N" EXIT
38END ;
39 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")
40 S QAMPARAM="P3" D EN3^QAMUTL1 I $D(DIRUT) S Y=-1 G Y
41 I QAMLABST>Y W *7,!!?5,"*** Ending value must be greater than or equal to the starting value ***",!,*7 G START
42 S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P3")=Y
43EXIT K Y
44Y Q
Note: See TracBrowser for help on using the repository browser.