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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMC21 3314 printed Dec 13, 2024@01:42:05 Page 2
QAMC21 ;HISC/DAD-CONDITION: LAB-CHEM,HEM,TOX,RIA,SER,ETC ;5/20/93 13:17
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** CONDITION CODE
+1 SET QAMLRTST=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:^("P1"),1:"")
+2 SET QAM0=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:^("P2"),1:"")
+3 SET QAM1=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P3"))#2:^("P3"),1:"")
+4 FOR QAMLRVDT=QAMTODAY-.0000001:0
SET QAMLRVDT=$ORDER(^LRO(69,QAMLRVDT))
if (QAMLRVDT'>0)!(QAMLRVDT>(QAMTODAY+.9999999))
QUIT
SET QAMLRLOC=""
FOR QAMLRLOC(0)=0:0
SET QAMLRLOC=$ORDER(^LRO(69,QAMLRVDT,1,"AN",QAMLRLOC))
if QAMLRLOC=""
QUIT
DO LOOP1
+5 KILL QAM0,QAM1,QAMDD,QAMDDFLD,QAMDDTYP,QAMLABD0,QAMLABD1,QAMLABDD,QAMLABGL,QAMLABST,QAMLRDAT,QAMLRDFN,QAMLRGLB,QAMLRIDT,QAMLRLOC,QAMLRTST,QAMLRVDT
+6 QUIT
LOOP1 FOR QAMLRDFN=0:0
SET QAMLRDFN=$ORDER(^LRO(69,QAMLRVDT,1,"AN",QAMLRLOC,QAMLRDFN))
if QAMLRDFN'>0
QUIT
FOR QAMLRIDT=0:0
SET QAMLRIDT=$ORDER(^LRO(69,QAMLRVDT,1,"AN",QAMLRLOC,QAMLRDFN,QAMLRIDT))
if QAMLRIDT'>0
QUIT
DO LOOP2
+1 QUIT
LOOP2 SET QAMDFN=$SELECT($DATA(^LR(QAMLRDFN,0))#2:^(0),1:"")
if $PIECE(QAMDFN,"^",2)'=2
QUIT
SET QAMDFN=+$PIECE(QAMDFN,"^",3)
if $DATA(^DPT(QAMDFN,0))[0
QUIT
+1 if $DATA(^LR(QAMLRDFN,"CH",QAMLRIDT,0))[0
QUIT
+2 SET QAMLRGLB=$PIECE(QAMLRTST,"^",4,999)
if QAMLRGLB=""
QUIT
+3 SET QAMLABD0=QAMLRDFN
SET QAMLABD1=QAMLRIDT
SET QA="QAMLRDAT="_QAMLRGLB
SET @QA
+4 if QAMLRDAT=""
QUIT
SET QAMTYPE=$PIECE(QAMLRTST,"^",3)
+5 ; SET OF CODES
IF QAMTYPE="S"
IF QAMLRDAT=QAM0
DO SET
QUIT
+6 ; FREE TEXT
IF QAMTYPE="F"
IF QAMLRDAT[QAM0
DO SET
QUIT
+7 ; NUMRIC
SET QAMLRDAT=$TRANSLATE(QAMLRDAT,$TRANSLATE(QAMLRDAT,"-.0123456789"))
+8 IF $EXTRACT(QAMLRDAT,$LENGTH(QAMLRDAT))="."
SET QAMLRDAT=$EXTRACT(QAMLRDAT,1,$LENGTH(QAMLRDAT)-1)
+9 ; NUMERIC
IF QAMLRDAT?.N.1"."1.N
IF QAMLRDAT'<QAM0
IF QAMLRDAT'>QAM1
DO SET
+10 QUIT
SET SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAMDFN)=""
SET ^(QAMDFN,9999999-QAMLRIDT)=QAMLRDFN_"^"_QAMLRIDT
+1 QUIT
EN2 ; *** PARAMETER CODE
+1 KILL DIC,DIR,DIRUT
SET DIC=60
SET DIC(0)="EMNQZ"
SET DIC("S")="S QA=^(0) I $P(QA,""^"",4)=""CH"",$P(QA,""^"",12)]"""""
+2 SET DIC("A")="LAB TEST: "
SET DIC("B")=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:$PIECE(^("P1"),"^",2),1:"")
if DIC("B")=""
KILL DIC("B")
+3 SET DIR("?")="Enter the name of an individual lab test whose result you want to monitor."
+4 SET QAMPARAM="P1"
DO EN2^QAMUTL1
IF ($DATA(DIRUT))!(Y="")
SET Y=-1
GOTO Y
+5 SET QAMDD(0)=$PIECE(Y(0),"^",12)
SET QAMDD=$PIECE(QAMDD(0),"DD(",2)
SET QAMLABDD=@("^"_QAMDD(0)_"0)")
SET QAMDDFLD=$PIECE(QAMLABDD,"^")
SET QAMDDTYP=$EXTRACT($PIECE(QAMLABDD,"^",2))
+6 SET QAMLABGL=$PIECE(QAMLABDD,"^",4)
SET QA="$P($G(^LR(QAMLABD0,""CH"",QAMLABD1,"_$PIECE(QAMLABGL,";")_")),""^"","_+$PIECE(QAMLABGL,";",2)_")"
+7 ; LAB TEST IEN ^ LAB TEST NAME ^ LAB TEST DATA TYPE ^ GLOBAL LOCATION
if Y]""
SET ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y_"^"_Y(0,0)_"^"_QAMDDTYP_"^"_QA
START ;
+1 KILL DIR
SET DIR("A")=$SELECT(QAMDDTYP="N":"STARTING VALUE ",1:"")_QAMDDFLD
SET DIR(0)=+QAMDD_","_+$PIECE(QAMDD,",",2)
SET DIR("B")=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:$PIECE(^("P2"),"^"),1:"")
if DIR("B")=""
KILL DIR("B")
+2 SET QAMPARAM="P2"
DO EN3^QAMUTL1
IF $DATA(DIRUT)
SET Y=-1
GOTO Y
+3 SET ^QA(743,QAMD0,"COND",QAMD1,"P2")=$SELECT(QAMDDTYP="S":Y_"^"_Y(0),1:Y)
SET QAMLABST=Y
+4 if QAMDDTYP'="N"
GOTO EXIT
END ;
+1 KILL DIR
SET DIR("A")="ENDING VALUE "_QAMDDFLD
SET DIR(0)=+QAMDD_","_+$PIECE(QAMDD,",",2)
SET DIR("B")=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P3"))#2:$PIECE(^("P3"),"^"),1:"")
if DIR("B")=""
KILL DIR("B")
+2 SET QAMPARAM="P3"
DO EN3^QAMUTL1
IF $DATA(DIRUT)
SET Y=-1
GOTO Y
+3 IF QAMLABST>Y
WRITE *7,!!?5,"*** Ending value must be greater than or equal to the starting value ***",!,*7
GOTO START
+4 if Y]""
SET ^QA(743,QAMD0,"COND",QAMD1,"P3")=Y
EXIT KILL Y
Y QUIT
