AMQQATAL ; IHS/CMI/THL - SETS TEMP METADICTIONARY ENTRY FOR LAB TESTS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
; All hard sets in this routine are for temporary purposes only
SETLAB ; ENTRY POINT
N X,%,Y,A
S %=$G(^AMQQ(5,+AMQQATN,4))
Q:%=""
S AMQQLTYP=$P(%,U)
S AMQQLDFN=$P(%,U,2)
S AMQQLSIT=$P(%,U,3)
S AMQQLHED=$P(%,U,4)
S AMQQLHDL=$P(%,U,5)
S AMQQLUNT=$P(%,U,6)
S AMQQLOUT=$P(%,U,7)
S AMQQLINK=AMQQATN
S AMQQNOL=""
S:'AMQQLSIT AMQQLSIT=+$O(^LAB(61,"B","UNKNOWN",0))
D OK
I $D(AMQQNOL) W:'$D(AMQQXX) !,"No results for this test are in the database. Don't bother asking.",!,*7 G EXIT
D MSG
I $D(AMQQNOL) Q
S AMQQLINK=AMQQLINK+($J/100000)
S %=AMQQLTYP
S AMQQLNNA=$S(%=9:1,%=12:2,%=11:3,%=15:4,%=6:6,1:"")
S %="^2^9000010.09^.04^9^^1^1^^AUPNVLAB^^3.7^AC^^^^"
S $P(%,U,1)="PATIENT;"_AMQQATNM
S $P(%,U,5)=AMQQLTYP
S $P(%,U,9)=AMQQATNM
S $P(%,U,11)=AMQQLDFN
S $P(%,U,15)=AMQQLDFN
S ^AMQQ(1,AMQQLINK,0)=%
S %=^AMQQ(1,9,1)
S %=$P(%,"XXX")_AMQQLDFN_$P(%,"XXX",2)
S ^AMQQ(1,AMQQLINK,1)=%
S ^AMQQ(1,AMQQLINK,1.1)=^AMQQ(1,9,1.1)
D STG
S %=^AMQQ(1,9,1.2)
S %=$P(%,"XXX")_X_$P(%,"XXX",2)
S %=$P(%,"YYY")_AMQQLNNA_$P(%,"YYY",2)
S ^AMQQ(1,AMQQLINK,1.2)=%
S %=^AMQQ(1,9,2)
S %=$P(%,"XXX")_X_$P(%,"XXX",2)
S %=$P(%,"YYY")_AMQQLNNA_$P(%,"YYY",2)
S ^AMQQ(1,AMQQLINK,2)=%
S ^AMQQ(1,AMQQLINK,4,0)="^9009071,01^2^2"
S ^AMQQ(1,AMQQLINK,4,1,0)=AMQQLHED_U_9000010.09_U_.04_U_AMQQLHED_U_AMQQLHDL_U_AMQQLHDL_U_AMQQLUNT I AMQQLOUT'="" S ^(1)=AMQQLOUT
S ^AMQQ(1,AMQQLINK,4,2,0)=AMQQLHED_" DATE"_U_9000010_U_.01_U_AMQQLHED_" DATE"_U_12_U_12,^(1)="S Y=X X ^DD(""DD"") S X=Y"
S ^AMQQ(1,AMQQLINK,9)=AMQQATNM_" RESULTS^RESULTS^EXPANDED LAB REPORT"
EXIT K AMQQLDFN,AMQQLTYP,AMQQLSIT,AMQQLHED,AMQQLHDL,AMQQLUNT,AMQQLOUT,AMQQLUNT,AMQQLNNA,I,J,X,Y,Z,%,B,N,A
Q
;
EN1 ; ENTRY POINT FROM AMQQSQA0
N AMQQLINK,AMQQ,AMQQATNM S AMQQATN=+Y,AMQQATNM=$P(Y,U,2) N X,Y,%
D SETLAB
Q
;
OKATTRIB(AMQQATN) ;EP;
S %=^AMQQ(5,AMQQATN,4)
S AMQQLTYP=$P(%,U)
S AMQQLDFN=$P(%,U,2)
S AMQQLSIT=$P(%,U,3)
S AMQQLHED=$P(%,U,4)
S AMQQLHDL=$P(%,U,5)
S AMQQLUNT=$P(%,U,6)
S AMQQLOUT=$P(%,U,7)
S AMQQLINK=AMQQATN
S AMQQNOL=""
S:'AMQQLSIT AMQQLSIT=+$O(^LAB(61,"B","UNKNOWN",0))
S AMQQNOL=""
D:AMQQLDFN OK
I '$D(AMQQNOL)
Q
OK N AMQQLX,AMQQLI,X,Y,%
I $D(^AUPNVLAB("B",AMQQLDFN)) K AMQQNOL S AMQQLENO=AMQQLDFN_"."_AMQQLSIT
I $G(AMQQLSIT)=44 S AMQQLDFN(AMQQLENO)="" Q
I AMQQLSIT'=72 D Q
.F %=0:0 S %=$O(^AMQQ(5,"LC",AMQQLINK\1,%)) Q:'% I $D(^AUPNVLAB("B",%)) K AMQQNOL S AMQQLDFN(%,".",AMQQLSIT)="",AMQQLDFN(AMQQLDFN_"."_AMQQLSIT)=""
S AMQQLX=AMQQLDFN_U
F %=0:0 S %=$O(^AMQQ(5,"LC",AMQQLINK,%)) Q:'% S AMQQLX=AMQQLX_%_U
F AMQQLI=1:1 S X=$P(AMQQLX,U,AMQQLI) Q:'X I $D(^AUPNVLAB("B",X)) K AMQQNOL D
.F Y=72,70,73 I $D(^LAB(60,X,1,Y)) S AMQQLDFN(X_"."_Y)=""
Q
MSG I $D(AMQQXX) Q
W !
I $D(AMQQLCOF) D SEL Q
I $D(AMQQLDFN)<9 S X=AMQQLDFN D LINE Q
S %=$O(AMQQLDFN(0))
I % S %=$O(AMQQLDFN(%)) I % W !,"The following tests will be included in the query =>",!
E Q
S AMQQLI=0
F S AMQQLI=$O(AMQQLDFN(AMQQLI)) Q:'AMQQLI S X=AMQQLI D LINE
K AMQQLI
Q
;
LINE W !,?2
I $D(AMQQLCOF) W J,") "
I AMQQLSIT=72 S %=+$P(X,".",2) S %=$S(%=7:"BLOOD ",%=70:"BLOOD ",%=72:"SERUM ",%=73:"PLASMA ",1:"") W %
W $P(^LAB(60,X\1,0),U)
S Y=AMQQLSIT
I %'="" S Y=+$P(X,".",2)
S %=$G(^LAB(60,X\1,1,Y,0))
I %'="" W:$P(%,U,2) " ",$P(%,U,2)," - ",$P(%,U,3)," ",$P(%,U,7) I $P(%,U,4)*$P(%,U,5) W " [critical: <",$P(%,U,4)," and >",$P(%,U,5),"]"
Q
;
SEL ;
I $D(AMQQLDFN)=0 G SELEXIT
I $D(AMQQLDFN)=1 S X=AMQQLDFN_"."_AMQQLSIT D LINE G SELEXIT
S (N,J)=0
S I=0
F S I=$O(AMQQLDFN(I)) Q:'I S N=N+1
I N=1 S X=$O(AMQQLFDN(0)),X=AMQQLDFN(X) D LINE G SELEXIT
S X=0
F S X=$O(AMQQLDFN(X)) Q:'X S J=J+1,AMQQLCOF(X)=J D LINE
SELR R !!,?2,"Your choice: ",X:DTIME E S X=U
I X?1."?" W !,"Enter a number from 1 to ",N," or string numbers together with commas; e.g. 1,",N G SELR
I "^"[$E(X) S AMQQNOL="" W !!,"ATTRIBUTE CANCELLED...",!!,*7 G SELEXIT
S Z=U
F I=1:1 S Y=$P(X,",",I) Q:Y="" S:(('Y)!(Y>N)) Y="" W:Y'?1N " ??",*7 G:Y'?1N SELR S Z=Z_Y_U
S I=0
F S I=$O(AMQQLDFN(I)) Q:'I S N=+$G(AMQQLCOF(I)) I Z'[(U_N_U) K AMQQLDFN(I)
SELEXIT K AMQQLCOF
Q
;
STG ;
I $D(AMQQLDFN)=1 S X=AMQQLDFN D STG1 Q
S X=""
S %=$O(AMQQLDFN(0))
Q:'% D S:X'="" X=X_":" S X=X_A
.S Y=(%\1)-.0000001,A="",%=Y+1
.S Z=Y F S Z=$O(AMQQLDFN(Z)) Q:'Z Q:Z>(Y+1) D
..S B=Z
..I B=(B\1) S B=B_".00"
..I A="" S A=B Q
..S A=A_"."_+$P(B,".",2)
Q
STG1 ;
N %,N S N=0
F %=70:1:79 I $D(^LAB(60,AMQQLDFN,1,%)) D
.I ((%=70)!(%=73)),$D(^LAB(60,AMQQLDFN,1,72)) Q
.S N=N+1
.I N=2 S %=99
I N=2 S X=X_"."_AMQQLSIT
Q
;
AMQQATAL ; IHS/CMI/THL - SETS TEMP METADICTIONARY ENTRY FOR LAB TESTS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 ; All hard sets in this routine are for temporary purposes only
SETLAB ; ENTRY POINT
+1 NEW X,%,Y,A
+2 SET %=$GET(^AMQQ(5,+AMQQATN,4))
+3 IF %=""
QUIT
+4 SET AMQQLTYP=$PIECE(%,U)
+5 SET AMQQLDFN=$PIECE(%,U,2)
+6 SET AMQQLSIT=$PIECE(%,U,3)
+7 SET AMQQLHED=$PIECE(%,U,4)
+8 SET AMQQLHDL=$PIECE(%,U,5)
+9 SET AMQQLUNT=$PIECE(%,U,6)
+10 SET AMQQLOUT=$PIECE(%,U,7)
+11 SET AMQQLINK=AMQQATN
+12 SET AMQQNOL=""
+13 IF 'AMQQLSIT
SET AMQQLSIT=+$ORDER(^LAB(61,"B","UNKNOWN",0))
+14 DO OK
+15 IF $DATA(AMQQNOL)
IF '$DATA(AMQQXX)
WRITE !,"No results for this test are in the database. Don't bother asking.",!,*7
GOTO EXIT
+16 DO MSG
+17 IF $DATA(AMQQNOL)
QUIT
+18 SET AMQQLINK=AMQQLINK+($JOB/100000)
+19 SET %=AMQQLTYP
+20 SET AMQQLNNA=$SELECT(%=9:1,%=12:2,%=11:3,%=15:4,%=6:6,1:"")
+21 SET %="^2^9000010.09^.04^9^^1^1^^AUPNVLAB^^3.7^AC^^^^"
+22 SET $PIECE(%,U,1)="PATIENT;"_AMQQATNM
+23 SET $PIECE(%,U,5)=AMQQLTYP
+24 SET $PIECE(%,U,9)=AMQQATNM
+25 SET $PIECE(%,U,11)=AMQQLDFN
+26 SET $PIECE(%,U,15)=AMQQLDFN
+27 SET ^AMQQ(1,AMQQLINK,0)=%
+28 SET %=^AMQQ(1,9,1)
+29 SET %=$PIECE(%,"XXX")_AMQQLDFN_$PIECE(%,"XXX",2)
+30 SET ^AMQQ(1,AMQQLINK,1)=%
+31 SET ^AMQQ(1,AMQQLINK,1.1)=^AMQQ(1,9,1.1)
+32 DO STG
+33 SET %=^AMQQ(1,9,1.2)
+34 SET %=$PIECE(%,"XXX")_X_$PIECE(%,"XXX",2)
+35 SET %=$PIECE(%,"YYY")_AMQQLNNA_$PIECE(%,"YYY",2)
+36 SET ^AMQQ(1,AMQQLINK,1.2)=%
+37 SET %=^AMQQ(1,9,2)
+38 SET %=$PIECE(%,"XXX")_X_$PIECE(%,"XXX",2)
+39 SET %=$PIECE(%,"YYY")_AMQQLNNA_$PIECE(%,"YYY",2)
+40 SET ^AMQQ(1,AMQQLINK,2)=%
+41 SET ^AMQQ(1,AMQQLINK,4,0)="^9009071,01^2^2"
+42 SET ^AMQQ(1,AMQQLINK,4,1,0)=AMQQLHED_U_9000010.09_U_.04_U_AMQQLHED_U_AMQQLHDL_U_AMQQLHDL_U_AMQQLUNT
IF AMQQLOUT'=""
SET ^(1)=AMQQLOUT
+43 SET ^AMQQ(1,AMQQLINK,4,2,0)=AMQQLHED_" DATE"_U_9000010_U_.01_U_AMQQLHED_" DATE"_U_12_U_12
SET ^(1)="S Y=X X ^DD(""DD"") S X=Y"
+44 SET ^AMQQ(1,AMQQLINK,9)=AMQQATNM_" RESULTS^RESULTS^EXPANDED LAB REPORT"
EXIT KILL AMQQLDFN,AMQQLTYP,AMQQLSIT,AMQQLHED,AMQQLHDL,AMQQLUNT,AMQQLOUT,AMQQLUNT,AMQQLNNA,I,J,X,Y,Z,%,B,N,A
+1 QUIT
+2 ;
EN1 ; ENTRY POINT FROM AMQQSQA0
+1 NEW AMQQLINK,AMQQ,AMQQATNM
SET AMQQATN=+Y
SET AMQQATNM=$PIECE(Y,U,2)
NEW X,Y,%
+2 DO SETLAB
+3 QUIT
+4 ;
OKATTRIB(AMQQATN) ;EP;
+1 SET %=^AMQQ(5,AMQQATN,4)
+2 SET AMQQLTYP=$PIECE(%,U)
+3 SET AMQQLDFN=$PIECE(%,U,2)
+4 SET AMQQLSIT=$PIECE(%,U,3)
+5 SET AMQQLHED=$PIECE(%,U,4)
+6 SET AMQQLHDL=$PIECE(%,U,5)
+7 SET AMQQLUNT=$PIECE(%,U,6)
+8 SET AMQQLOUT=$PIECE(%,U,7)
+9 SET AMQQLINK=AMQQATN
+10 SET AMQQNOL=""
+11 IF 'AMQQLSIT
SET AMQQLSIT=+$ORDER(^LAB(61,"B","UNKNOWN",0))
+12 SET AMQQNOL=""
+13 IF AMQQLDFN
DO OK
+14 IF '$DATA(AMQQNOL)
+15 QUIT
OK NEW AMQQLX,AMQQLI,X,Y,%
+1 IF $DATA(^AUPNVLAB("B",AMQQLDFN))
KILL AMQQNOL
SET AMQQLENO=AMQQLDFN_"."_AMQQLSIT
+2 IF $GET(AMQQLSIT)=44
SET AMQQLDFN(AMQQLENO)=""
QUIT
+3 IF AMQQLSIT'=72
Begin DoDot:1
+4 FOR %=0:0
SET %=$ORDER(^AMQQ(5,"LC",AMQQLINK\1,%))
IF '%
QUIT
IF $DATA(^AUPNVLAB("B",%))
KILL AMQQNOL
SET AMQQLDFN(%,".",AMQQLSIT)=""
SET AMQQLDFN(AMQQLDFN_"."_AMQQLSIT)=""
End DoDot:1
QUIT
+5 SET AMQQLX=AMQQLDFN_U
+6 FOR %=0:0
SET %=$ORDER(^AMQQ(5,"LC",AMQQLINK,%))
IF '%
QUIT
SET AMQQLX=AMQQLX_%_U
+7 FOR AMQQLI=1:1
SET X=$PIECE(AMQQLX,U,AMQQLI)
IF 'X
QUIT
IF $DATA(^AUPNVLAB("B",X))
KILL AMQQNOL
Begin DoDot:1
+8 FOR Y=72,70,73
IF $DATA(^LAB(60,X,1,Y))
SET AMQQLDFN(X_"."_Y)=""
End DoDot:1
+9 QUIT
MSG IF $DATA(AMQQXX)
QUIT
+1 WRITE !
+2 IF $DATA(AMQQLCOF)
DO SEL
QUIT
+3 IF $DATA(AMQQLDFN)<9
SET X=AMQQLDFN
DO LINE
QUIT
+4 SET %=$ORDER(AMQQLDFN(0))
+5 IF %
SET %=$ORDER(AMQQLDFN(%))
IF %
WRITE !,"The following tests will be included in the query =>",!
+6 IF '$TEST
QUIT
+7 SET AMQQLI=0
+8 FOR
SET AMQQLI=$ORDER(AMQQLDFN(AMQQLI))
IF 'AMQQLI
QUIT
SET X=AMQQLI
DO LINE
+9 KILL AMQQLI
+10 QUIT
+11 ;
LINE WRITE !,?2
+1 IF $DATA(AMQQLCOF)
WRITE J,") "
+2 IF AMQQLSIT=72
SET %=+$PIECE(X,".",2)
SET %=$SELECT(%=7:"BLOOD ",%=70:"BLOOD ",%=72:"SERUM ",%=73:"PLASMA ",1:"")
WRITE %
+3 WRITE $PIECE(^LAB(60,X\1,0),U)
+4 SET Y=AMQQLSIT
+5 IF %'=""
SET Y=+$PIECE(X,".",2)
+6 SET %=$GET(^LAB(60,X\1,1,Y,0))
+7 IF %'=""
IF $PIECE(%,U,2)
WRITE " ",$PIECE(%,U,2)," - ",$PIECE(%,U,3)," ",$PIECE(%,U,7)
IF $PIECE(%,U,4)*$PIECE(%,U,5)
WRITE " [critical: <",$PIECE(%,U,4)," and >",$PIECE(%,U,5),"]"
+8 QUIT
+9 ;
SEL ;
+1 IF $DATA(AMQQLDFN)=0
GOTO SELEXIT
+2 IF $DATA(AMQQLDFN)=1
SET X=AMQQLDFN_"."_AMQQLSIT
DO LINE
GOTO SELEXIT
+3 SET (N,J)=0
+4 SET I=0
+5 FOR
SET I=$ORDER(AMQQLDFN(I))
IF 'I
QUIT
SET N=N+1
+6 IF N=1
SET X=$ORDER(AMQQLFDN(0))
SET X=AMQQLDFN(X)
DO LINE
GOTO SELEXIT
+7 SET X=0
+8 FOR
SET X=$ORDER(AMQQLDFN(X))
IF 'X
QUIT
SET J=J+1
SET AMQQLCOF(X)=J
DO LINE
SELR READ !!,?2,"Your choice: ",X:DTIME
IF '$TEST
SET X=U
+1 IF X?1."?"
WRITE !,"Enter a number from 1 to ",N," or string numbers together with commas; e.g. 1,",N
GOTO SELR
+2 IF "^"[$EXTRACT(X)
SET AMQQNOL=""
WRITE !!,"ATTRIBUTE CANCELLED...",!!,*7
GOTO SELEXIT
+3 SET Z=U
+4 FOR I=1:1
SET Y=$PIECE(X,",",I)
IF Y=""
QUIT
IF (('Y)!(Y>N))
SET Y=""
IF Y'?1N
WRITE " ??",*7
IF Y'?1N
GOTO SELR
SET Z=Z_Y_U
+5 SET I=0
+6 FOR
SET I=$ORDER(AMQQLDFN(I))
IF 'I
QUIT
SET N=+$GET(AMQQLCOF(I))
IF Z'[(U_N_U)
KILL AMQQLDFN(I)
SELEXIT KILL AMQQLCOF
+1 QUIT
+2 ;
STG ;
+1 IF $DATA(AMQQLDFN)=1
SET X=AMQQLDFN
DO STG1
QUIT
+2 SET X=""
+3 SET %=$ORDER(AMQQLDFN(0))
+4 IF '%
QUIT
Begin DoDot:1
+5 SET Y=(%\1)-.0000001
SET A=""
SET %=Y+1
+6 SET Z=Y
FOR
SET Z=$ORDER(AMQQLDFN(Z))
IF 'Z
QUIT
IF Z>(Y+1)
QUIT
Begin DoDot:2
+7 SET B=Z
+8 IF B=(B\1)
SET B=B_".00"
+9 IF A=""
SET A=B
QUIT
+10 SET A=A_"."_+$PIECE(B,".",2)
End DoDot:2
End DoDot:1
IF X'=""
SET X=X_":"
SET X=X_A
+11 QUIT
STG1 ;
+1 NEW %,N
SET N=0
+2 FOR %=70:1:79
IF $DATA(^LAB(60,AMQQLDFN,1,%))
Begin DoDot:1
+3 IF ((%=70)!(%=73))
IF $DATA(^LAB(60,AMQQLDFN,1,72))
QUIT
+4 SET N=N+1
+5 IF N=2
SET %=99
End DoDot:1
+6 IF N=2
SET X=X_"."_AMQQLSIT
+7 QUIT
+8 ;
