Routine: AMQQMGR6

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!",!!

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

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)

ATTRIB ;EP;TO CHECK FOR USE OF LAB BY V LAB

 I $D(^AUPNVLAB("B",$P(+Y,".")/1000))

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

AMQQMGR6.m