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
Q
;
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)=%
Q
;
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"""
Q
;
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,",")
Q
;
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
Q
;
TT1 S $P(AMQQQ,U,12)=%
Q
;
SQ D SQ^AMQQATSQ
Q
;
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
Q
;
SQ2 N AMQQLSQF
S AMQQLSQF=AMQQSQLN
D SQ1
Q
;
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_""""
Q
;
STD S AMQQILIN=AMQQILIN+1,^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?6,""ALIVE TODAY"""
Q
;
ALIVE S Y=$P(Q,U,9)
X ^DD("DD")
S %="W ?6,""ALIVE AS OF "_Y_""""
Q
;
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"""
Q
;
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"""
Q
;
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 %=%_""""
Q
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
