AMQQSQA2 ; IHS/CMI/THL - SUB-SUBQUERIES ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
I $D(AMQQMMMM) D AUTO G EXIT
VAR D P1
D V1
S $P(AMQQSQSQ,U,5,6)=AMQQSQSJ_U_AMQQSQP1
S AMQQCOMP=";;"
S %=$P($G(^AMQQ(5,AMQQSQN,5)),U,2)
I %,%=$P($G(^AMQQ(5,AMQQSQSN,5)),U,2) S $P(AMQQSQSQ,U,7)=1,$P(AMQQSQSQ,U,1,2)="+0^+0" G CKTAX
Q1 W !!,"Do you want to screen each ",AMQQSQAN," according to the",!
D QX
W " on the ",@AMQQRV,"SAME",@AMQQNV," visit"
S %=1
D YN^DICN
S:$D(DTOUT)+$D(DUOUT) %Y=U
K DTOUT,DUOUT
I %Y=U S AMQQQUIT="" G EXIT
I %Y?1."?" W !!,"If you answer ""YES"" you can screen each ",AMQQSQAN," according to",!,AMQQSQP1," from on the same visit",!! G Q1
I "Yy"[$E(%Y) S $P(AMQQSQSQ,U,7)=1,$P(AMQQSQSQ,U,1,2)="+0^+0" G CKTAX
Q2 W !!,"Well then, do you want me to screen each ",AMQQSQAN," according to",!
D QX
W " on ",@AMQQRV,"TEMPORALLY RELATED",@AMQQNV," visits"
S %=1
D YN^DICN
S:$D(DTOUT)+$D(DUOUT) %Y=U
K DTOUT,DUOUT
I %Y=U S AMQQQUIT="" G EXIT
I %Y?1."?" W !!,"If you answer ""YES"" you can screen ",AMQQSQP1," according to",!,"the value of a temporally related ",AMQQSQAN,!! G Q2
I "Yy"'[$E(%Y) S Y=-1 W " ??",*7 S AMQQQUIT="" G EXIT
DATE W !!
F Z="start","end" D D1 I $D(AMQQQUIT) G EXIT
I $P(AMQQSQSQ,U)>$P(AMQQSQSQ,U,2) W " ??",*7,!!,"The start of the time frame must preceed the end of the time frame!!!",!! G DATE
CKTAX S %=$P(^AMQQ(5,AMQQSQN,0),U,5)
S:%=9 %=AMQQSQN+($J/100000)
S %=$P(^AMQQ(1,%,0),U,5)
S %=$P(^AMQQ(4,%,0),U)
I %="G"!(%="L") D TAX I $D(AMQQQUIT) G EXIT
EXIT K X,%,%Y,Y,Z
Q
;
V1 S %=$P(^AMQQ(5,AMQQSQN,0),U,5)
S:%=9 %=AMQQSQN+($J/100000)
S $P(AMQQSQSQ,U,8,9)=%_U_AMQQSQNM
S %=$P(^AMQQ(1,%,0),U,5)
S %=$P(^AMQQ(4,%,0),U)
S $P(AMQQSQSQ,U,10)=%
Q
;
QX W $S(AMQQSQNM["PROVIDER":"the providers of record ",1:(AMQQSQNM_" values obtained"))
Q
;
D1 W !,"Enter the relative ",Z,"ing point of the time frame: "
R X:DTIME E S X=U
I X="" W !!,"Your answer is mandatory" D HELPD G D1
I $E(X)=U S AMQQQUIT="" G DENDK
I X?1."?" D HELPD G D1
I X=0!(X="0D")!(X="+0D")!(X="-0D") S X="+0D" W " (Same day)"
F Q:X'[" " S X=$P(X," ")_$P(X," ",2,99)
I $E(X)?1N S X="+"_X
I "-+"'[$E(X) W " ??",*7 G D1
S AMQQDATE(1)=$E(X),X=$E(X,2,99)
I $E(X)'?1N W " ??",*7 G D1
S AMQQDATE(2)=+X
S (X,AMQQDATE(3))=$P(X,+X,2)
I $L(X),"DWMY"[$E(X) S %=$E(X),Y=AMQQDATE(2)*$S(%="D":1,%="W":7,%="M":30.44,1:365.25),Y=Y\1 G DEND
W " ??",*7
G D1
DEND S $P(AMQQSQSQ,U,1+(Z="end"))=AMQQDATE(1)_Y
S Y=$E(AMQQDATE(3))
S %=$S(AMQQDATE(1)="-":" BEFORE",1:" AFTER")
S %=AMQQDATE(2)_" "_$S(Y="D":"DAY",Y="W":"WK",Y="M":"MO",1:"YR")_$S(AMQQDATE(2)>1:"S",1:"")_%
S $P(AMQQSQSQ,U,3+(Z="end"))=%
DENDK K AMQQDATE,Y
Q
;
HELPD W !!,"Answer in the following format: SIGN_NUMBER_TIME UNIT",!
W "For example: ""-6 MONTHS"" or ""+12 WEEKS""",!
W "The SIGN is relative to the primary visit with ""-"" designating a time prior to",!,"the visit and ""+"" designating a time after the visit.",!
W "If you do not enter a SIGN, I will assume it is a '+'",!
W "The TIME UNIT can be DAYS, WEEKS, MONTHS or YEARS. Abbreviations are OK.",!
W "Enter '0' to indicate the same day as the primary visit",!!!
Q
;
P1 N X,Y
S X=AMQQSQNM
I AMQQSQNM["(" S X=$P(AMQQSQNM,"(") D PLEURAL S AMQQSQP1=X_"("_$P(AMQQSQNM,"(",2,99) Q
D PLEURAL
S AMQQSQP1=X
Q
;
PLEURAL ; ENTRY POINT FROM MULTIPLE ROUTINES
I X="DIAGNOSIS" S X="DIAGNOSES" Q
S Y=$P(X,$L(X))
I Y="S" S X=$E(X,1,$L(X)-1)_"ES" Q
S X=X_"S"
Q
;
TAX N AMQQATNM,AMQQLINK,AMQQATN,AMQQSBCT,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX,AMQQTAX
S Y=AMQQSQN_U_AMQQSQNM
S %=^AMQQ(5,+Y,0)
S AMQQTTX=$G(^(3))
S AMQQATNM=$P(Y,U,2)
S AMQQATN=+Y
S AMQQSBCT=$P(%,U,20)
S AMQQTNAR=$P(%,U,15)
S AMQQTDIC=U_$P(%,U,16)
S AMQQTLOK=U_$P(%,U,18)
S AMQQLINK=$P(%,U,5)
D ^AMQQTX
I '$D(AMQQTAX) S AMQQQUIT=""
S $P(AMQQSQSQ,U,11)=AMQQTAX_$S($D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")):";INVERSE",$D(^("-")):";NULL",1:"")
Q
;
AUTO S AMQQCOMP=";;"
I $P(AMQQMMMM,";",2)="MTAX" S AMQQCOMP=";;;"_$P(AMQQMMMM,";",3)
S $P(AMQQSQSQ,U,1,2)=$P(AMQQMMMM,";",4)_U_$P(AMQQMMMM,";",5)
D V1
Q
;
AMQQSQA2 ; IHS/CMI/THL - SUB-SUBQUERIES ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 IF $DATA(AMQQMMMM)
DO AUTO
GOTO EXIT
VAR DO P1
+1 DO V1
+2 SET $PIECE(AMQQSQSQ,U,5,6)=AMQQSQSJ_U_AMQQSQP1
+3 SET AMQQCOMP=";;"
+4 SET %=$PIECE($GET(^AMQQ(5,AMQQSQN,5)),U,2)
+5 IF %
IF %=$PIECE($GET(^AMQQ(5,AMQQSQSN,5)),U,2)
SET $PIECE(AMQQSQSQ,U,7)=1
SET $PIECE(AMQQSQSQ,U,1,2)="+0^+0"
GOTO CKTAX
Q1 WRITE !!,"Do you want to screen each ",AMQQSQAN," according to the",!
+1 DO QX
+2 WRITE " on the ",@AMQQRV,"SAME",@AMQQNV," visit"
+3 SET %=1
+4 DO YN^DICN
+5 IF $DATA(DTOUT)+$DATA(DUOUT)
SET %Y=U
+6 KILL DTOUT,DUOUT
+7 IF %Y=U
SET AMQQQUIT=""
GOTO EXIT
+8 IF %Y?1."?"
WRITE !!,"If you answer ""YES"" you can screen each ",AMQQSQAN," according to",!,AMQQSQP1," from on the same visit",!!
GOTO Q1
+9 IF "Yy"[$EXTRACT(%Y)
SET $PIECE(AMQQSQSQ,U,7)=1
SET $PIECE(AMQQSQSQ,U,1,2)="+0^+0"
GOTO CKTAX
Q2 WRITE !!,"Well then, do you want me to screen each ",AMQQSQAN," according to",!
+1 DO QX
+2 WRITE " on ",@AMQQRV,"TEMPORALLY RELATED",@AMQQNV," visits"
+3 SET %=1
+4 DO YN^DICN
+5 IF $DATA(DTOUT)+$DATA(DUOUT)
SET %Y=U
+6 KILL DTOUT,DUOUT
+7 IF %Y=U
SET AMQQQUIT=""
GOTO EXIT
+8 IF %Y?1."?"
WRITE !!,"If you answer ""YES"" you can screen ",AMQQSQP1," according to",!,"the value of a temporally related ",AMQQSQAN,!!
GOTO Q2
+9 IF "Yy"'[$EXTRACT(%Y)
SET Y=-1
WRITE " ??",*7
SET AMQQQUIT=""
GOTO EXIT
DATE WRITE !!
+1 FOR Z="start","end"
DO D1
IF $DATA(AMQQQUIT)
GOTO EXIT
+2 IF $PIECE(AMQQSQSQ,U)>$PIECE(AMQQSQSQ,U,2)
WRITE " ??",*7,!!,"The start of the time frame must preceed the end of the time frame!!!",!!
GOTO DATE
CKTAX SET %=$PIECE(^AMQQ(5,AMQQSQN,0),U,5)
+1 IF %=9
SET %=AMQQSQN+($JOB/100000)
+2 SET %=$PIECE(^AMQQ(1,%,0),U,5)
+3 SET %=$PIECE(^AMQQ(4,%,0),U)
+4 IF %="G"!(%="L")
DO TAX
IF $DATA(AMQQQUIT)
GOTO EXIT
EXIT KILL X,%,%Y,Y,Z
+1 QUIT
+2 ;
V1 SET %=$PIECE(^AMQQ(5,AMQQSQN,0),U,5)
+1 IF %=9
SET %=AMQQSQN+($JOB/100000)
+2 SET $PIECE(AMQQSQSQ,U,8,9)=%_U_AMQQSQNM
+3 SET %=$PIECE(^AMQQ(1,%,0),U,5)
+4 SET %=$PIECE(^AMQQ(4,%,0),U)
+5 SET $PIECE(AMQQSQSQ,U,10)=%
+6 QUIT
+7 ;
QX WRITE $SELECT(AMQQSQNM["PROVIDER":"the providers of record ",1:(AMQQSQNM_" values obtained"))
+1 QUIT
+2 ;
D1 WRITE !,"Enter the relative ",Z,"ing point of the time frame: "
+1 READ X:DTIME
IF '$TEST
SET X=U
+2 IF X=""
WRITE !!,"Your answer is mandatory"
DO HELPD
GOTO D1
+3 IF $EXTRACT(X)=U
SET AMQQQUIT=""
GOTO DENDK
+4 IF X?1."?"
DO HELPD
GOTO D1
+5 IF X=0!(X="0D")!(X="+0D")!(X="-0D")
SET X="+0D"
WRITE " (Same day)"
+6 FOR
IF X'[" "
QUIT
SET X=$PIECE(X," ")_$PIECE(X," ",2,99)
+7 IF $EXTRACT(X)?1N
SET X="+"_X
+8 IF "-+"'[$EXTRACT(X)
WRITE " ??",*7
GOTO D1
+9 SET AMQQDATE(1)=$EXTRACT(X)
SET X=$EXTRACT(X,2,99)
+10 IF $EXTRACT(X)'?1N
WRITE " ??",*7
GOTO D1
+11 SET AMQQDATE(2)=+X
+12 SET (X,AMQQDATE(3))=$PIECE(X,+X,2)
+13 IF $LENGTH(X)
IF "DWMY"[$EXTRACT(X)
SET %=$EXTRACT(X)
SET Y=AMQQDATE(2)*$SELECT(%="D":1,%="W":7,%="M":30.44,1:365.25)
SET Y=Y\1
GOTO DEND
+14 WRITE " ??",*7
+15 GOTO D1
DEND SET $PIECE(AMQQSQSQ,U,1+(Z="end"))=AMQQDATE(1)_Y
+1 SET Y=$EXTRACT(AMQQDATE(3))
+2 SET %=$SELECT(AMQQDATE(1)="-":" BEFORE",1:" AFTER")
+3 SET %=AMQQDATE(2)_" "_$SELECT(Y="D":"DAY",Y="W":"WK",Y="M":"MO",1:"YR")_$SELECT(AMQQDATE(2)>1:"S",1:"")_%
+4 SET $PIECE(AMQQSQSQ,U,3+(Z="end"))=%
DENDK KILL AMQQDATE,Y
+1 QUIT
+2 ;
HELPD WRITE !!,"Answer in the following format: SIGN_NUMBER_TIME UNIT",!
+1 WRITE "For example: ""-6 MONTHS"" or ""+12 WEEKS""",!
+2 WRITE "The SIGN is relative to the primary visit with ""-"" designating a time prior to",!,"the visit and ""+"" designating a time after the visit.",!
+3 WRITE "If you do not enter a SIGN, I will assume it is a '+'",!
+4 WRITE "The TIME UNIT can be DAYS, WEEKS, MONTHS or YEARS. Abbreviations are OK.",!
+5 WRITE "Enter '0' to indicate the same day as the primary visit",!!!
+6 QUIT
+7 ;
P1 NEW X,Y
+1 SET X=AMQQSQNM
+2 IF AMQQSQNM["("
SET X=$PIECE(AMQQSQNM,"(")
DO PLEURAL
SET AMQQSQP1=X_"("_$PIECE(AMQQSQNM,"(",2,99)
QUIT
+3 DO PLEURAL
+4 SET AMQQSQP1=X
+5 QUIT
+6 ;
PLEURAL ; ENTRY POINT FROM MULTIPLE ROUTINES
+1 IF X="DIAGNOSIS"
SET X="DIAGNOSES"
QUIT
+2 SET Y=$PIECE(X,$LENGTH(X))
+3 IF Y="S"
SET X=$EXTRACT(X,1,$LENGTH(X)-1)_"ES"
QUIT
+4 SET X=X_"S"
+5 QUIT
+6 ;
TAX NEW AMQQATNM,AMQQLINK,AMQQATN,AMQQSBCT,AMQQTNAR,AMQQTDIC,AMQQTLOK,AMQQTTX,AMQQTAX
+1 SET Y=AMQQSQN_U_AMQQSQNM
+2 SET %=^AMQQ(5,+Y,0)
+3 SET AMQQTTX=$GET(^(3))
+4 SET AMQQATNM=$PIECE(Y,U,2)
+5 SET AMQQATN=+Y
+6 SET AMQQSBCT=$PIECE(%,U,20)
+7 SET AMQQTNAR=$PIECE(%,U,15)
+8 SET AMQQTDIC=U_$PIECE(%,U,16)
+9 SET AMQQTLOK=U_$PIECE(%,U,18)
+10 SET AMQQLINK=$PIECE(%,U,5)
+11 DO ^AMQQTX
+12 IF '$DATA(AMQQTAX)
SET AMQQQUIT=""
+13 SET $PIECE(AMQQSQSQ,U,11)=AMQQTAX_$SELECT($DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"--")):";INVERSE",$DATA(^("-")):";NULL",1:"")
+14 QUIT
+15 ;
AUTO SET AMQQCOMP=";;"
+1 IF $PIECE(AMQQMMMM,";",2)="MTAX"
SET AMQQCOMP=";;;"_$PIECE(AMQQMMMM,";",3)
+2 SET $PIECE(AMQQSQSQ,U,1,2)=$PIECE(AMQQMMMM,";",4)_U_$PIECE(AMQQMMMM,";",5)
+3 DO V1
+4 QUIT
+5 ;
