AMQQMGR4 ; IHS/CMI/THL - OVERFLOW FROM AMQQMGR3 ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
LHEAD ; ENTRY POINT FROM AMQQMGR3 ; GETS HEADER INFO
I AMQQLSPX S AMQQLUNT=$P($G(^LAB(60,AMQQLDFN,1,AMQQLSPX,0)),U,7)
E S AMQQLUNT=""
S AMQQLHN=$P($G(^LAB(60,AMQQLDFN,.1)),U)
S AMQQLHL=$L(AMQQLHN)
S AMQQLOUT=""
I AMQQLHN'="" G LHT
S N=99
F I=1:1 S X=$P(AMQQLSTG,U,I) Q:X="" I $L(X)<N S Y=X,N=$L(X)
I N=99 Q
S AMQQLHN=Y
S AMQQLHL=N
LHT I AMQQLTYP=9 S %=$P(^LAB(60,AMQQLDFN,0),U,12),%=U_%_"0)",%=$P(@%,U,2),%=+$E(%,4,9) G LH1
I AMQQLTYP=15 S %=8,AMQQLOUT="S X=$P(X,"" ""),X=$S(X="""":""??"",X=0:""Neg."",X=+X:(""1:""_X),1:X)" G LH1
I AMQQLTYP=12 S AMQQLOUT="S X=$P(X,"" "") S:X'?1N X=""??"" S:X?1N X=X+1,X=$P(""Neg.;Trace;1+;2+;3+;4+"","";"",X)" G LH1
I AMQQLTYP=11 S AMQQLOUT="S X=$S($E(X)=""P"",""Pos"",1:""Neg"")",%=4 G LH1
I AMQQLTYP=6 S %=0,X=$P(^LAB(60,AMQQLDFN,0),U,12),X=U_X_"0)",X=$P(@X,U,3) D LOUT F I=1:1 S Y=$P(X,";",I) G:Y="" LH1 S Y=$P(Y,":",2),Y=$L(Y) I Y>% S %=Y
I AMQQLTYP=2 S %=0,X=$P(^LAB(60,AMQQLDFN,0),U,12) Q:X="" S X=U_X_"0)",X=$P($G(@X),U,5),%=+$P(X,"K:$L(X)>",2)
LH1 I (%+4)>AMQQLHL S AMQQLHL=(%+4)
Q
;
LOUT S AMQQLOUT="N Y S Y="";"_X_""",X=$F(Y,("";""_X_"":"")),X=$E(Y,X,999),X=$P(X,"";"")"
Q
;
CO ; ENTRY POINT FROM AMQQMGR3
S %=^LAB(60,AMQQLDFN,0)
S %=$P(%,U)
S %=$P(%," (")
S %=$P(%,"(")
S AMQQLC=%
Q:%=""
S AMQQLCO=%
D CO2
I $D(AMQQLCOF) G COEXIT
I $D(AMQQCONO) K AMQQCONO G COEXIT
F AMQQLI=70:1:79 I $D(^LAB(60,AMQQLDFN,1,AMQQLI,0)) D CO1
COEXIT K AMQQLC,AMQQLCO,AMQQLI
Q
;
CO1 S %=$P("BLOOD^URINE^SERUM^PLASMA^CSF^URETHRAL FLUID^PERITONEAL FLUID^PLEURAL FLUID^SYNOVIAL FLUID^CLOT",U,(AMQQLI-69)),AMQQLCO=AMQQLC_","_%
CO2 S %=$O(^AMQQ(5,"C",AMQQLCO,""))
Q:'%
S DA(1)=%
S X=AMQQLDFN
S DIC="^AMQQ(5,"_DA(1)_",4.1,"
S DIC(0)="L"
I '$D(^AMQQ(5,DA(1),4.1,0)) S ^(0)="^9009075.02PA^^"
D ^DIC
K DIC
I Y'=-1 S AMQQLCOF=""
W !,$P(^LAB(60,AMQQLDFN,0),U)," added as a companion test of ",AMQQLCO
Q
;
TOP ; ENTRY POINT ; GETS TOP 40 LAB TESTS
D CHECK
S I=$P(^AUPNVLAB(0),U,4)\500
S G="^UTILITY(""AMQQ"",$J,""LU"")"
S Z=""
K @G
F X=0:0 S X=$O(^AUPNVLAB(X)) Q:'X S Y=+^(X,0),%=$G(@G@(1,Y))+1,^(Y)=%,X=X+I W:X#2 "."
F X=0:0 S X=$O(@G@(1,X)) Q:'X S Y=^(X),@G@(2,(10000-Y),X)="" W:X#2 "."
W !!!,?15,"***** TOP 40 LAB TESTS *****",!!!
S I=0
F X=0:0 S X=$O(@G@(2,X)) Q:'X F Y=0:0 S Y=$O(@G@(2,X,Y)) Q:'Y S I=I+1 W:I#2 ! W:'(I#2) ?40 W I,") ",$E($P(^LAB(60,Y,0),U),1,30)," [",(10000-X),"]" S Z=Z_Y_U I I=40 G TOP1
TOP1 S AMQQLUST=Z
D STUFF
K @G,X,Y,Z,I,%
Q
;
GET ; ENTRY POINT FOR 1 AT A TIME LAB TESTS
D CHECK
S Z=""
F D I Y=-1!($E(Y)=U) Q
.I $L(Z)>235 S Y="" W !!,"I can't accept more new tests now. If you want to add more, try again later",!! Q
.S DIR(0)="PO^60:EMQ"
.S DIR("A")="Lab test"
.S DIR("?")="Enter the name of the test you want to add to the Q-Man metadictionary."
.D ^DIR
.K DIR
.I +Y=175 D NEWGLU
.I +Y=643 W " <= It's already in there" Q
.I $D(^AMQQ(5,1000+Y)) W " <= It's already in there!" Q
.I (U_Z)[(U_Y_U) W " <= Already selected" Q
.S Z=Z_Y_U
S AMQQLUST=Z
D STUFF
Q
;
STUFF W !!!
F AMQQLSN=1:1 S X=$P(AMQQLUST,U,AMQQLSN) Q:X="" D EN1^AMQQMGR3
K AMQQLUST,AMQQLSN,X,Y,Z
Q
;
LIST ; - EP - FROM ^AMQQMGR
W !!!
F X=1000:0 S X=$O(^AMQQ(5,X)) Q:'X S Y=^(X,0),Y=$P(Y,U) W Y,", "
K X,Y
Q
;
CHECK ;
S Z=0
S X=$P(^AUPNVLAB(0),U,3)-1000
F I=1:1:1000 S X=$O(^AUPNVLAB(X)) Q:'X I $P($G(^AUPNVLAB(X,11)),U,3) S Z=1 Q
I Z
W:'Z !!,"Specimen/site not entered into V LAB...Request cancelled",!!,*7 H 2
K X,Z,I
Q
;
NEWGLU S DA(1)=184
S DIK="^AMQQ(5,"_DA(1)_",1,"
F DA=0:0 S DA=$O(^AMQQ(5,184,1,DA)) Q:'DA D ^DIK
K DIK,DA
Q
;
AMQQMGR4 ; IHS/CMI/THL - OVERFLOW FROM AMQQMGR3 ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
LHEAD ; ENTRY POINT FROM AMQQMGR3 ; GETS HEADER INFO
+1 IF AMQQLSPX
SET AMQQLUNT=$PIECE($GET(^LAB(60,AMQQLDFN,1,AMQQLSPX,0)),U,7)
+2 IF '$TEST
SET AMQQLUNT=""
+3 SET AMQQLHN=$PIECE($GET(^LAB(60,AMQQLDFN,.1)),U)
+4 SET AMQQLHL=$LENGTH(AMQQLHN)
+5 SET AMQQLOUT=""
+6 IF AMQQLHN'=""
GOTO LHT
+7 SET N=99
+8 FOR I=1:1
SET X=$PIECE(AMQQLSTG,U,I)
IF X=""
QUIT
IF $LENGTH(X)<N
SET Y=X
SET N=$LENGTH(X)
+9 IF N=99
QUIT
+10 SET AMQQLHN=Y
+11 SET AMQQLHL=N
LHT IF AMQQLTYP=9
SET %=$PIECE(^LAB(60,AMQQLDFN,0),U,12)
SET %=U_%_"0)"
SET %=$PIECE(@%,U,2)
SET %=+$EXTRACT(%,4,9)
GOTO LH1
+1 IF AMQQLTYP=15
SET %=8
SET AMQQLOUT="S X=$P(X,"" ""),X=$S(X="""":""??"",X=0:""Neg."",X=+X:(""1:""_X),1:X)"
GOTO LH1
+2 IF AMQQLTYP=12
SET AMQQLOUT="S X=$P(X,"" "") S:X'?1N X=""??"" S:X?1N X=X+1,X=$P(""Neg.;Trace;1+;2+;3+;4+"","";"",X)"
GOTO LH1
+3 IF AMQQLTYP=11
SET AMQQLOUT="S X=$S($E(X)=""P"",""Pos"",1:""Neg"")"
SET %=4
GOTO LH1
+4 IF AMQQLTYP=6
SET %=0
SET X=$PIECE(^LAB(60,AMQQLDFN,0),U,12)
SET X=U_X_"0)"
SET X=$PIECE(@X,U,3)
DO LOUT
FOR I=1:1
SET Y=$PIECE(X,";",I)
IF Y=""
GOTO LH1
SET Y=$PIECE(Y,":",2)
SET Y=$LENGTH(Y)
IF Y>%
SET %=Y
+5 IF AMQQLTYP=2
SET %=0
SET X=$PIECE(^LAB(60,AMQQLDFN,0),U,12)
IF X=""
QUIT
SET X=U_X_"0)"
SET X=$PIECE($GET(@X),U,5)
SET %=+$PIECE(X,"K:$L(X)>",2)
LH1 IF (%+4)>AMQQLHL
SET AMQQLHL=(%+4)
+1 QUIT
+2 ;
LOUT SET AMQQLOUT="N Y S Y="";"_X_""",X=$F(Y,("";""_X_"":"")),X=$E(Y,X,999),X=$P(X,"";"")"
+1 QUIT
+2 ;
CO ; ENTRY POINT FROM AMQQMGR3
+1 SET %=^LAB(60,AMQQLDFN,0)
+2 SET %=$PIECE(%,U)
+3 SET %=$PIECE(%," (")
+4 SET %=$PIECE(%,"(")
+5 SET AMQQLC=%
+6 IF %=""
QUIT
+7 SET AMQQLCO=%
+8 DO CO2
+9 IF $DATA(AMQQLCOF)
GOTO COEXIT
+10 IF $DATA(AMQQCONO)
KILL AMQQCONO
GOTO COEXIT
+11 FOR AMQQLI=70:1:79
IF $DATA(^LAB(60,AMQQLDFN,1,AMQQLI,0))
DO CO1
COEXIT KILL AMQQLC,AMQQLCO,AMQQLI
+1 QUIT
+2 ;
CO1 SET %=$PIECE("BLOOD^URINE^SERUM^PLASMA^CSF^URETHRAL FLUID^PERITONEAL FLUID^PLEURAL FLUID^SYNOVIAL FLUID^CLOT",U,(AMQQLI-69))
SET AMQQLCO=AMQQLC_","_%
CO2 SET %=$ORDER(^AMQQ(5,"C",AMQQLCO,""))
+1 IF '%
QUIT
+2 SET DA(1)=%
+3 SET X=AMQQLDFN
+4 SET DIC="^AMQQ(5,"_DA(1)_",4.1,"
+5 SET DIC(0)="L"
+6 IF '$DATA(^AMQQ(5,DA(1),4.1,0))
SET ^(0)="^9009075.02PA^^"
+7 DO ^DIC
+8 KILL DIC
+9 IF Y'=-1
SET AMQQLCOF=""
+10 WRITE !,$PIECE(^LAB(60,AMQQLDFN,0),U)," added as a companion test of ",AMQQLCO
+11 QUIT
+12 ;
TOP ; ENTRY POINT ; GETS TOP 40 LAB TESTS
+1 DO CHECK
+2 SET I=$PIECE(^AUPNVLAB(0),U,4)\500
+3 SET G="^UTILITY(""AMQQ"",$J,""LU"")"
+4 SET Z=""
+5 KILL @G
+6 FOR X=0:0
SET X=$ORDER(^AUPNVLAB(X))
IF 'X
QUIT
SET Y=+^(X,0)
SET %=$GET(@G@(1,Y))+1
SET ^(Y)=%
SET X=X+I
IF X#2
WRITE "."
+7 FOR X=0:0
SET X=$ORDER(@G@(1,X))
IF 'X
QUIT
SET Y=^(X)
SET @G@(2,(10000-Y),X)=""
IF X#2
WRITE "."
+8 WRITE !!!,?15,"***** TOP 40 LAB TESTS *****",!!!
+9 SET I=0
+10 FOR X=0:0
SET X=$ORDER(@G@(2,X))
IF 'X
QUIT
FOR Y=0:0
SET Y=$ORDER(@G@(2,X,Y))
IF 'Y
QUIT
SET I=I+1
IF I#2
WRITE !
IF '(I#2)
WRITE ?40
WRITE I,") ",$EXTRACT($PIECE(^LAB(60,Y,0),U),1,30)," [",(10000-X),"]"
SET Z=Z_Y_U
IF I=40
GOTO TOP1
TOP1 SET AMQQLUST=Z
+1 DO STUFF
+2 KILL @G,X,Y,Z,I,%
+3 QUIT
+4 ;
GET ; ENTRY POINT FOR 1 AT A TIME LAB TESTS
+1 DO CHECK
+2 SET Z=""
+3 FOR
Begin DoDot:1
+4 IF $LENGTH(Z)>235
SET Y=""
WRITE !!,"I can't accept more new tests now. If you want to add more, try again later",!!
QUIT
+5 SET DIR(0)="PO^60:EMQ"
+6 SET DIR("A")="Lab test"
+7 SET DIR("?")="Enter the name of the test you want to add to the Q-Man metadictionary."
+8 DO ^DIR
+9 KILL DIR
+10 IF +Y=175
DO NEWGLU
+11 IF +Y=643
WRITE " <= It's already in there"
QUIT
+12 IF $DATA(^AMQQ(5,1000+Y))
WRITE " <= It's already in there!"
QUIT
+13 IF (U_Z)[(U_Y_U)
WRITE " <= Already selected"
QUIT
+14 SET Z=Z_Y_U
End DoDot:1
IF Y=-1!($EXTRACT(Y)=U)
QUIT
+15 SET AMQQLUST=Z
+16 DO STUFF
+17 QUIT
+18 ;
STUFF WRITE !!!
+1 FOR AMQQLSN=1:1
SET X=$PIECE(AMQQLUST,U,AMQQLSN)
IF X=""
QUIT
DO EN1^AMQQMGR3
+2 KILL AMQQLUST,AMQQLSN,X,Y,Z
+3 QUIT
+4 ;
LIST ; - EP - FROM ^AMQQMGR
+1 WRITE !!!
+2 FOR X=1000:0
SET X=$ORDER(^AMQQ(5,X))
IF 'X
QUIT
SET Y=^(X,0)
SET Y=$PIECE(Y,U)
WRITE Y,", "
+3 KILL X,Y
+4 QUIT
+5 ;
CHECK ;
+1 SET Z=0
+2 SET X=$PIECE(^AUPNVLAB(0),U,3)-1000
+3 FOR I=1:1:1000
SET X=$ORDER(^AUPNVLAB(X))
IF 'X
QUIT
IF $PIECE($GET(^AUPNVLAB(X,11)),U,3)
SET Z=1
QUIT
+4 IF Z
+5 IF 'Z
WRITE !!,"Specimen/site not entered into V LAB...Request cancelled",!!,*7
HANG 2
+6 KILL X,Z,I
+7 QUIT
+8 ;
NEWGLU SET DA(1)=184
+1 SET DIK="^AMQQ(5,"_DA(1)_",1,"
+2 FOR DA=0:0
SET DA=$ORDER(^AMQQ(5,184,1,DA))
IF 'DA
QUIT
DO ^DIK
+3 KILL DIK,DA
+4 QUIT
+5 ;
