- 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 ;
