AMQQMGR6 ; IHS/CMI/THL - AMQQMGR CONTINUED ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
N %,%Y
K ^UTILITY("AMQQ LC",$J),^UTILITY("AMQQ DEL",$J)
W !!,"Want to view/print the existing set of Q-Man lab tests"
S %=2
D YN^DICN
I %Y?1."^" Q
I %=1 D SYN1^AMQQMGR8
W !!,"Want to update the existing set of Q-Man lab tests"
S %=2
D YN^DICN
I %=1 D EN^AMQQMGR3
S TMP="^TMP(""AMQQ LAB IEN"","_$J_")"
S AMQQCNT=0
K @TMP
W !!
S AMQQLIEN=0
F S AMQQLIEN=$O(^LAB(60,AMQQLIEN)) Q:'AMQQLIEN D INV(AMQQLIEN)
W AMQQCNT," lab unique lab tests have been detected. ",!!
D GETAKA^AMQQMGR8
W !!
D SYN^AMQQMGR8
K AMQQSTOP
W !!,"The Q-Man LAB TEST update is now complete!",!!
Q
;
INV(AMQQLIEN) ; MAINTAIN INVENTORY OF LAB TESTS
N I,J,%,Z,AMQQSIEN,AMQQDA,AMQQSTOP,AMQQX
S (AMQQSIEN,I,J)=0
F I=0:1 S AMQQSIEN=$O(^LAB(60,AMQQLIEN,1,AMQQSIEN)) Q:'AMQQSIEN ; COUNT S/Ss
I 'I S %=AMQQLIEN_"."_44 D DETECT(%) Q ; NO S/S
I I=1 S Z=$O(^LAB(60,AMQQLIEN,1,0)),%=AMQQLIEN_"."_Z D DETECT(%) Q ; ONLY ONE SITE/SPECIMEN
S %=AMQQLIEN_"."_44 D DETECT(%) ; CAPTURE THE UNKNOWN S/S IF IT EXISTS
S AMQQDA=0 F S AMQQDA=$O(^AUPNVLAB("B",AMQQLIEN,AMQQDA)) Q:'AMQQDA D I $G(AMQQSTOP) Q
.S Z=$P($G(^AUPNVLAB(AMQQDA,11)),U,3) I Z="" Q ; UNKNOWN S/S
.I $D(AMQQX(Z)) Q ; IT ALREADY IN THERE
.S %=AMQQLIEN_"."_Z
.D DETECT(%)
.S J=J+1,AMQQX(%)=J
.I J=I S AMQQSTOP=1 ; ALL S/Ss ACCOUNTED FOR
Q
DETECT(%) ; DETECT LAB TEST TYPES
N X,Y,N,Z,J,K
S Z=$P(%,".",2)
S J=+%
S K=(%\1)_"."_$P(J,".",2)
I $D(@TMP@(K)) Q
S X=$P($G(^LAB(60,+(%\1),0)),U)
I X="" Q
S Y=$P($G(^LAB(61,+Z,0)),U)
S N=X
I $L(Y) S N=N_", "_Y I Y="UNKNOWN" S N=N_" SOURCE"
S @TMP@(K)=N
S @TMP@("B",N,K)=""
S @TMP@("C",K)=Z
I $P($G(^AMQQ(5,(K+1000),4)),U,8) Q
S AMQQCNT=AMQQCNT+1
W AMQQCNT," unique lab tests have been detected so far",$C(13)
Q
;
ATTRIB ;EP;TO CHECK FOR USE OF LAB BY V LAB
I $D(^AUPNVLAB("B",$P(+Y,".")/1000))
Q
AMQQMGR6 ; IHS/CMI/THL - AMQQMGR CONTINUED ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 NEW %,%Y
+4 KILL ^UTILITY("AMQQ LC",$JOB),^UTILITY("AMQQ DEL",$JOB)
+5 WRITE !!,"Want to view/print the existing set of Q-Man lab tests"
+6 SET %=2
+7 DO YN^DICN
+8 IF %Y?1."^"
QUIT
+9 IF %=1
DO SYN1^AMQQMGR8
+10 WRITE !!,"Want to update the existing set of Q-Man lab tests"
+11 SET %=2
+12 DO YN^DICN
+13 IF %=1
DO EN^AMQQMGR3
+14 SET TMP="^TMP(""AMQQ LAB IEN"","_$JOB_")"
+15 SET AMQQCNT=0
+16 KILL @TMP
+17 WRITE !!
+18 SET AMQQLIEN=0
+19 FOR
SET AMQQLIEN=$ORDER(^LAB(60,AMQQLIEN))
IF 'AMQQLIEN
QUIT
DO INV(AMQQLIEN)
+20 WRITE AMQQCNT," lab unique lab tests have been detected. ",!!
+21 DO GETAKA^AMQQMGR8
+22 WRITE !!
+23 DO SYN^AMQQMGR8
+24 KILL AMQQSTOP
+25 WRITE !!,"The Q-Man LAB TEST update is now complete!",!!
+26 QUIT
+27 ;
INV(AMQQLIEN) ; MAINTAIN INVENTORY OF LAB TESTS
+1 NEW I,J,%,Z,AMQQSIEN,AMQQDA,AMQQSTOP,AMQQX
+2 SET (AMQQSIEN,I,J)=0
+3 ; COUNT S/Ss
FOR I=0:1
SET AMQQSIEN=$ORDER(^LAB(60,AMQQLIEN,1,AMQQSIEN))
IF 'AMQQSIEN
QUIT
+4 ; NO S/S
IF 'I
SET %=AMQQLIEN_"."_44
DO DETECT(%)
QUIT
+5 ; ONLY ONE SITE/SPECIMEN
IF I=1
SET Z=$ORDER(^LAB(60,AMQQLIEN,1,0))
SET %=AMQQLIEN_"."_Z
DO DETECT(%)
QUIT
+6 ; CAPTURE THE UNKNOWN S/S IF IT EXISTS
SET %=AMQQLIEN_"."_44
DO DETECT(%)
+7 SET AMQQDA=0
FOR
SET AMQQDA=$ORDER(^AUPNVLAB("B",AMQQLIEN,AMQQDA))
IF 'AMQQDA
QUIT
Begin DoDot:1
+8 ; UNKNOWN S/S
SET Z=$PIECE($GET(^AUPNVLAB(AMQQDA,11)),U,3)
IF Z=""
QUIT
+9 ; IT ALREADY IN THERE
IF $DATA(AMQQX(Z))
QUIT
+10 SET %=AMQQLIEN_"."_Z
+11 DO DETECT(%)
+12 SET J=J+1
SET AMQQX(%)=J
+13 ; ALL S/Ss ACCOUNTED FOR
IF J=I
SET AMQQSTOP=1
End DoDot:1
IF $GET(AMQQSTOP)
QUIT
+14 QUIT
DETECT(%) ; DETECT LAB TEST TYPES
+1 NEW X,Y,N,Z,J,K
+2 SET Z=$PIECE(%,".",2)
+3 SET J=+%
+4 SET K=(%\1)_"."_$PIECE(J,".",2)
+5 IF $DATA(@TMP@(K))
QUIT
+6 SET X=$PIECE($GET(^LAB(60,+(%\1),0)),U)
+7 IF X=""
QUIT
+8 SET Y=$PIECE($GET(^LAB(61,+Z,0)),U)
+9 SET N=X
+10 IF $LENGTH(Y)
SET N=N_", "_Y
IF Y="UNKNOWN"
SET N=N_" SOURCE"
+11 SET @TMP@(K)=N
+12 SET @TMP@("B",N,K)=""
+13 SET @TMP@("C",K)=Z
+14 IF $PIECE($GET(^AMQQ(5,(K+1000),4)),U,8)
QUIT
+15 SET AMQQCNT=AMQQCNT+1
+16 WRITE AMQQCNT," unique lab tests have been detected so far",$CHAR(13)
+17 QUIT
+18 ;
ATTRIB ;EP;TO CHECK FOR USE OF LAB BY V LAB
+1 IF $DATA(^AUPNVLAB("B",$PIECE(+Y,".")/1000))
+2 QUIT
