- 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 Feb 18, 2025@23:08:28 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
