Routine: AMQQATL

AMQQATL ; IHS/CMI/THL - ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

 I $D(AMQQXX) Q

 S Q=AMQQQ

 I +Q=33,Q[";;;NULL" D STD Q

 I +Q=256 S ^UTILITY("AMQQ",$J,"LIST",200)="W !,?6,""Secondary chart numbers will be displayed if they exist""" Q

 I +Q=454 S ^UTILITY("AMQQ",$J,"LIST",200)="W !,?6,""Only CURRENT Private Insurers will be displayed if they EXIST""" Q

 I $P(Q,U,9)["NULL" S Z=": NONE EXIST" D NULL G EXIT

 I $P(Q,U,9)["EXIST"!($P(Q,U,9)[";ALL") S Z=" EXISTS" D NULL I '$P(Q,U,4) G EXIT

 I $P(Q,U,9)[";ANY" S Z=" ANY VALUE INCLUDING NULL" D NULL Q

 S %=$P(AMQQQ,U,9)

 S %=$P(%,";",4)

 I %[">:-888"!(%["'<:NEG")!(%["|||") S Z=" ALL VALUES" D NULL Q

 I $P(Q,U,4) D SQ G EXIT

 I $P(Q,U,17)'="" D TATT G EXIT

 D LATT

EXIT I $D(^UTILITY("AMQQ",$J,"LIST",AMQQILIN)),$D(AMQQKONG) S %=^(AMQQILIN) I %[",""" S %=$P(%,",""")_",""[OR #"_AMQQKGNO_"] "_$P(%,",""",2,99),^(AMQQILIN)=%

 K AMQQFTYP,AMQQVCL,Q,%,X,Y,Z

LATT I $P(Q,U,2)="ALIVE" D ALIVE,L1 Q

 I $P(Q,U,2)="COHORT" D COHORT,L1 Q

 I $P(Q,U,2)="FILE ENTRY" D FILE,L1 Q

 S %="W ?6"

 I $P(Q,U,7)="EQUAL TO" S $P(Q,U,7)="="

 S %=%_","""

 I $P(Q,U,2)'=$E($P(Q,U,7),1,$L($P(Q,U,2))) D

 . S %=%_$P(Q,U,2)

 . I $P(Q,U,3)="S",$P(Q,U,7)="IS" S %=%_": """ Q

 . S %=%_" "

 I $P(Q,U,3)'="S"!($P(Q,U,7)'="IS") S %=%_$P(Q,U,7)_" """

 S AMQQFTYP=$P(Q,U,3)

 S AMQQVCL=$P(Q,U,10)

 I AMQQFTYP="Y" S %="W ?6,""PROVIDER ATTRIBUTES AS SPECIFIED""" G LSER

 I $P(Q,U,3)="B" D BLOOD G LSER

 S X=$P(Q,U,9)

 S Y=$P(X,";")

 D TRANS

 I X[";",$P(X,";")'=$P(X,";",2) S %=%_","" and """,Y=$P(X,";",2) D TRANS

LSER S $P(AMQQQ,U,12)=%

L1 S AMQQILIN=AMQQILIN+1

 S ^UTILITY("AMQQ",$J,"LIST",AMQQILIN)=%

TRANS I AMQQFTYP="D" X ^DD("DD") G SETA

 I AMQQFTYP="B" S Y=X

 I AMQQFTYP="F",$P(Q,U,8)="<>" S Y=$S(Y=" ":"FIRST ENTRY",Y="|||||":"LAST ENTRY",1:Y) G SETA

 I AMQQFTYP="L" D LOOK G SETA

 I AMQQFTYP="S" S Z=$P(^DD($P(AMQQVCL,","),$P(AMQQVCL,",",2),0),U,3),Z=";"_Z,Y=$F(Z,(";"_X_":")),Y=$E(Z,Y,99),Y=$P(Y,";")

 I +$G(Q)>764,+$G(Q)<768 S Y=Y-1

SETA S %=%_","""_Y_""""

 I +$G(Q)>764,+$G(Q)<768 S %=%_","""_" days"""

LOOK S (Z,DIC)=$P(^AMQQ(1,+Q,0),U,3)

 S DIC(0)="",X="`"_$P(Q,U,9)

 D ^DIC

 K DIC

 S Y=$P(Y,U,2)

 I Y'["," Q

 I Z'=2,Z'=6,Z'=16,Z'=9000001 Q

 S Y=$P(Y,",",2)_" "_$P(Y,",")

TATT S %="W ?6,"""_$P(Q,U,2)

 S X=$P(Q,U,9)

 S X=$P(X,";",4)

 S Z=" AS SPECIFIED"

 D ZSET^AMQQATL1

 S %=%_$S($D(AMQQONE):"",X="NULL":" IS 'NULL'",X="EXISTS":" EXISTS",1:Z)

 S %=%_""""

 D TT1

 D L1

TT1 S $P(AMQQQ,U,12)=%

SQ D SQ^AMQQATSQ

SQ1 ; - EP -

 N %,X

 F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQL",AMQQLSQF,%)) Q:'%  S AMQQILIN=AMQQILIN+1,X=^(%),^UTILITY("AMQQ",$J,"LIST",AMQQILIN)=X I $D(^UTILITY("AMQQ",$J,"SQXL",AMQQLSQF,%)) S AMQQSQLN=$O(^(%,"")) D SQ2

SQ2 N AMQQLSQF

 S AMQQLSQF=AMQQSQLN

 D SQ1

NULL I $P(Q,U,4),'$D(AMQQGVF),"GL"[$P(Q,U,3) Q

 S AMQQATNM=$P(Q,U,2)

 S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?6,"""_AMQQATNM_Z_""""

 S $P(AMQQQ,U,12)="W ?6,"""_AMQQATNM_""""

STD S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?6,""ALIVE TODAY"""

ALIVE S Y=$P(Q,U,9)

 X ^DD("DD")

 S %="W ?6,""ALIVE AS OF "_Y_""""

COHORT S Y=+$P(Q,U,9)

 S Y=$P(^DIBT(Y,0),U)

 S %="W ?6,"""_$S(((+Q=151)!(+Q=85)):"NOT A MEMBER",((+Q=166)!(+Q=86)):"RANDOM SAMPLE",1:"MEMBER")_" OF '"_Y_"' COHORT"""

FILE S %=$P(Q,U,9)

 S Y=$P(%,";")

 S Y=@(U_Y_"0)")

 S Y=$P(Y,U)

 I +Q=176,Y="BW PATIENT" S %="W ?6,""REGISTERED IN THE WOMEN'S HEALTH DATABASE""" Q

 S %="W ?6,"""_$S(+Q=176:"ENTERED",+Q=177:"NOT ENTERED",1:"RANDOM SAMPLE OF PATIENTS")_" IN THE '"_Y_"' FILE"""

BLOOD N Y,X

 S Y=$P(Q,U,9)

 S X=$P(Y,";")

 D TRANS^AMQQAVB

 S X(1)=X

 S X=$P(Y,";",2)

 D:X'="" TRANS^AMQQAVB

 S X(2)=X

 S $P(AMQQQ,U,9)=X(1)_";"_X(2)

 S %=%_","""_$P(Y,";")_"""" I $P(Y,";",2)'="" S %=%_","" and "_$P(Y,";",2) S %=%_""""

AMQQATL   ; IHS/CMI/THL - ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

 +3        IF $DATA(AMQQXX)

               QUIT

 +4        SET Q=AMQQQ

 +5        IF +Q=33

               IF Q[";;;NULL"

                   DO STD

                   QUIT

 +6        IF +Q=256

               SET ^UTILITY("AMQQ",$JOB,"LIST",200)="W !,?6,""Secondary chart numbers will be displayed if they exist"""

               QUIT

 +7        IF +Q=454

               SET ^UTILITY("AMQQ",$JOB,"LIST",200)="W !,?6,""Only CURRENT Private Insurers will be displayed if they EXIST"""

               QUIT

 +8        IF $PIECE(Q,U,9)["NULL"

               SET Z=": NONE EXIST"

               DO NULL

               GOTO EXIT

 +9        IF $PIECE(Q,U,9)["EXIST"!($PIECE(Q,U,9)[";ALL")

               SET Z=" EXISTS"

               DO NULL

               IF '$PIECE(Q,U,4)

                   GOTO EXIT

 +10       IF $PIECE(Q,U,9)[";ANY"

               SET Z=" ANY VALUE INCLUDING NULL"

               DO NULL

               QUIT

 +11       SET %=$PIECE(AMQQQ,U,9)

 +12       SET %=$PIECE(%,";",4)

 +13       IF %[">:-888"!(%["'<:NEG")!(%["|||")

               SET Z=" ALL VALUES"

               DO NULL

               QUIT

 +14       IF $PIECE(Q,U,4)

               DO SQ

               GOTO EXIT

 +15       IF $PIECE(Q,U,17)'=""

               DO TATT

               GOTO EXIT

 +16       DO LATT

EXIT       IF $DATA(^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN))

               IF $DATA(AMQQKONG)

                   SET %=^(AMQQILIN)

                   IF %[","""

                       SET %=$PIECE(%,",""")_",""[OR #"_AMQQKGNO_"] "_$PIECE(%,",""",2,99)

                       SET ^(AMQQILIN)=%

 +1        KILL AMQQFTYP,AMQQVCL,Q,%,X,Y,Z

 +2        QUIT

 +3       ;

LATT       IF $PIECE(Q,U,2)="ALIVE"

               DO ALIVE

               DO L1

               QUIT

 +1        IF $PIECE(Q,U,2)="COHORT"

               DO COHORT

               DO L1

               QUIT

 +2        IF $PIECE(Q,U,2)="FILE ENTRY"

               DO FILE

               DO L1

               QUIT

 +3        SET %="W ?6"

 +4        IF $PIECE(Q,U,7)="EQUAL TO"

               SET $PIECE(Q,U,7)="="

 +5        SET %=%_","""

 +6        IF $PIECE(Q,U,2)'=$EXTRACT($PIECE(Q,U,7),1,$LENGTH($PIECE(Q,U,2)))

               Begin DoDot:1

 +7                SET %=%_$PIECE(Q,U,2)

 +8                IF $PIECE(Q,U,3)="S"

                       IF $PIECE(Q,U,7)="IS"

                           SET %=%_": """

                           QUIT

 +9                SET %=%_" "

               End DoDot:1

 +10       IF $PIECE(Q,U,3)'="S"!($PIECE(Q,U,7)'="IS")

               SET %=%_$PIECE(Q,U,7)_" """

 +11       SET AMQQFTYP=$PIECE(Q,U,3)

 +12       SET AMQQVCL=$PIECE(Q,U,10)

 +13       IF AMQQFTYP="Y"

               SET %="W ?6,""PROVIDER ATTRIBUTES AS SPECIFIED"""

               GOTO LSER

 +14       IF $PIECE(Q,U,3)="B"

               DO BLOOD

               GOTO LSER

 +15       SET X=$PIECE(Q,U,9)

 +16       SET Y=$PIECE(X,";")

 +17       DO TRANS

 +18       IF X[";"

               IF $PIECE(X,";")'=$PIECE(X,";",2)

                   SET %=%_","" and """

                   SET Y=$PIECE(X,";",2)

                   DO TRANS

LSER       SET $PIECE(AMQQQ,U,12)=%

L1         SET AMQQILIN=AMQQILIN+1

 +1        SET ^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN)=%

 +2        QUIT

 +3       ;

TRANS      IF AMQQFTYP="D"

               XECUTE ^DD("DD")

               GOTO SETA

 +1        IF AMQQFTYP="B"

               SET Y=X

 +2        IF AMQQFTYP="F"

               IF $PIECE(Q,U,8)="<>"

                   SET Y=$SELECT(Y=" ":"FIRST ENTRY",Y="|||||":"LAST ENTRY",1:Y)

                   GOTO SETA

 +3        IF AMQQFTYP="L"

               DO LOOK

               GOTO SETA

 +4        IF AMQQFTYP="S"

               SET Z=$PIECE(^DD($PIECE(AMQQVCL,","),$PIECE(AMQQVCL,",",2),0),U,3)

               SET Z=";"_Z

               SET Y=$FIND(Z,(";"_X_":"))

               SET Y=$EXTRACT(Z,Y,99)

               SET Y=$PIECE(Y,";")

 +5        IF +$GET(Q)>764

               IF +$GET(Q)<768

                   SET Y=Y-1

SETA       SET %=%_","""_Y_""""

 +1        IF +$GET(Q)>764

               IF +$GET(Q)<768

                   SET %=%_","""_" days"""

 +2        QUIT

 +3       ;

LOOK       SET (Z,DIC)=$PIECE(^AMQQ(1,+Q,0),U,3)

 +1        SET DIC(0)=""

           SET X="`"_$PIECE(Q,U,9)

 +2        DO ^DIC

 +3        KILL DIC

 +4        SET Y=$PIECE(Y,U,2)

 +5        IF Y'[","

               QUIT

 +6        IF Z'=2

               IF Z'=6

                   IF Z'=16

                       IF Z'=9000001

                           QUIT

 +7        SET Y=$PIECE(Y,",",2)_" "_$PIECE(Y,",")

 +8        QUIT

 +9       ;

TATT       SET %="W ?6,"""_$PIECE(Q,U,2)

 +1        SET X=$PIECE(Q,U,9)

 +2        SET X=$PIECE(X,";",4)

 +3        SET Z=" AS SPECIFIED"

 +4        DO ZSET^AMQQATL1

 +5        SET %=%_$SELECT($DATA(AMQQONE):"",X="NULL":" IS 'NULL'",X="EXISTS":" EXISTS",1:Z)

 +6        SET %=%_""""

 +7        DO TT1

 +8        DO L1

 +9        QUIT

 +10      ;

TT1        SET $PIECE(AMQQQ,U,12)=%

 +1        QUIT

 +2       ;

SQ         DO SQ^AMQQATSQ

 +1        QUIT

 +2       ;

SQ1       ; - EP -

 +1        NEW %,X

 +2        FOR %=0:0

               SET %=$ORDER(^UTILITY("AMQQ",$JOB,"SQL",AMQQLSQF,%))

               IF '%

                   QUIT

               SET AMQQILIN=AMQQILIN+1

               SET X=^(%)

               SET ^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN)=X

               IF $DATA(^UTILITY("AMQQ",$JOB,"SQXL",AMQQLSQF,%))

                   SET AMQQSQLN=$ORDER(^(%,""))

                   DO SQ2

 +3        QUIT

 +4       ;

SQ2        NEW AMQQLSQF

 +1        SET AMQQLSQF=AMQQSQLN

 +2        DO SQ1

 +3        QUIT

 +4       ;

NULL       IF $PIECE(Q,U,4)

               IF '$DATA(AMQQGVF)

                   IF "GL"[$PIECE(Q,U,3)

                       QUIT

 +1        SET AMQQATNM=$PIECE(Q,U,2)

 +2        SET AMQQILIN=AMQQILIN+1

           SET ^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN)="W ?6,"""_AMQQATNM_Z_""""

 +3        SET $PIECE(AMQQQ,U,12)="W ?6,"""_AMQQATNM_""""

 +4        QUIT

 +5       ;

STD        SET AMQQILIN=AMQQILIN+1

           SET ^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN)="W ?6,""ALIVE TODAY"""

 +1        QUIT

 +2       ;

ALIVE      SET Y=$PIECE(Q,U,9)

 +1        XECUTE ^DD("DD")

 +2        SET %="W ?6,""ALIVE AS OF "_Y_""""

 +3        QUIT

 +4       ;

COHORT     SET Y=+$PIECE(Q,U,9)

 +1        SET Y=$PIECE(^DIBT(Y,0),U)

 +2        SET %="W ?6,"""_$SELECT(((+Q=151)!(+Q=85)):"NOT A MEMBER",((+Q=166)!(+Q=86)):"RANDOM SAMPLE",1:"MEMBER")_" OF '"_Y_"' COHORT"""

 +3        QUIT

 +4       ;

FILE       SET %=$PIECE(Q,U,9)

 +1        SET Y=$PIECE(%,";")

 +2        SET Y=@(U_Y_"0)")

 +3        SET Y=$PIECE(Y,U)

 +4        IF +Q=176

               IF Y="BW PATIENT"

                   SET %="W ?6,""REGISTERED IN THE WOMEN'S HEALTH DATABASE"""

                   QUIT

 +5        SET %="W ?6,"""_$SELECT(+Q=176:"ENTERED",+Q=177:"NOT ENTERED",1:"RANDOM SAMPLE OF PATIENTS")_" IN THE '"_Y_"' FILE"""

 +6        QUIT

 +7       ;

BLOOD      NEW Y,X

 +1        SET Y=$PIECE(Q,U,9)

 +2        SET X=$PIECE(Y,";")

 +3        DO TRANS^AMQQAVB

 +4        SET X(1)=X

 +5        SET X=$PIECE(Y,";",2)

 +6        IF X'=""

               DO TRANS^AMQQAVB

 +7        SET X(2)=X

 +8        SET $PIECE(AMQQQ,U,9)=X(1)_";"_X(2)

 +9        SET %=%_","""_$PIECE(Y,";")_""""

           IF $PIECE(Y,";",2)'=""

               SET %=%_","" and "_$PIECE(Y,";",2)

               SET %=%_""""

 +10       QUIT

AMQQATL.m