AMQQAVR ; IHS/CMI/THL - RELATIVE DATE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
TYPE W !,"Relative to what date =>",!!
S %="DATE OF BIRTH^DATE OF DEATH^A PARTICULAR AGE"
F I=1:1 S Y=$P(%,U,I) Q:Y="" W ?3,I,") ",Y,!
RT W !,"Your choice (1-",I-1,"): 1// "
R X:DTIME E S X=U
I X="" S X=1 W " (1)"
I X?1."?" W !!!,"Results are screened by comparing the date of result with the ""relative"" date",!! G RT
I $E(X)=U S AMQQQUIT="" G EXIT
I X?1N,X<I D @("R"_X) G EXIT
W " ??",*7
G RT
;
EXIT I $D(AMQQQUIT) S AMQQCOMP=""
I AMQQCOMP'="" S AMQQSQCV=AMQQCOMP
K X,Y,%,C,F,I,Z
Q
;
R1 ; BIRTHDAY
S AMQQCOMP="0^0^CDOB"
W !
R1RS W !,"Time window begins how long after patient's birth: "
S Z="1^R1RS^R1RE"
D RG
G @AMQQDEST
R1RE W !,"The window ends how long after birth: "
S Z="2^R1RE^R1CK"
D RG
G @AMQQDEST
R1CK I +AMQQCOMP'<$P(AMQQCOMP,U,2) W " ??",*7 G R1
D SET
Q
;
R2 ; DEATHDAY
S AMQQCOMP="0^0^CDOD" W !
R2RS W !,"The window of time begins how long before each patient's death: "
S Z="1^R2RS^R2RE"
D RG
G @AMQQDEST
R2RE W !,"The window ends how long before death: "
S Z="2^R1RE^R2CK"
D RG
G @AMQQDEST
R2CK I $P(AMQQCOMP,U,2)'<+AMQQCOMP W " ??",*7 G R2
D SET
Q
;
R3 ; AGE
W ! S AMQQCOMP="0^0^CAGE"
W !,"Enter the baseline age: "
R X:DTIME E S X=U
I U[$E(X) S AMQQQUIT="" Q
I X?1."?" D HELPA G R3
I X="" S AMQQCOMP="" Q
I X?1.N S X=X_"Y" I $G(AMQQCOMP)'["CDOB" W " (years)"
S F=""
D DATE
I Y=-1 G R3
S $P(AMQQCOMP,U,4)=Y
R3RS W !,"Enter beginning of time window relative to each patient's age: "
S Z="1^R3RS^R3RE^1"
D RG
G @AMQQDEST
R3RE W !,"Enter the end of the time window relative to the baseline age: "
S Z="2^R3RE^R3CK^1"
D RG
G @AMQQDEST
R3CK I +AMQQCOMP'<$P(AMQQCOMP,U,2) W " ??",*7 G R3
D SET
Q
;
RG R X:DTIME E S X=U
I X="" S X=$S(+Z=1:"0D",1:"999999D")
I X=U S AMQQQUIT="" S AMQQDEST="EXIT" Q
I X?1."?" D @("HELPD"_$P(Z,U,4)) S AMQQDEST=$P(Z,U,2) Q
I X?.1P1.N S X=X_"Y" I $G(AMQQCOMP)'["CDOB" W " (years)"
S F=""
D @("DATE"_$P(Z,U,4))
I Y=-1 S AMQQDEST=$P(Z,U,2) Q
S $P(AMQQCOMP,U,+Z)=Y
S AMQQDEST=$P(Z,U,3)
Q
;
DATE1 S F="+"
I $E(X)="+"!($E(X)="-") S F=$E(X),X=$E(X,2,99)
DATE I $E(X)'?1N G D1
I X?1.N W !!,"You must also specify time units; e.g. 6 MONTHS or 30 YEARS",!!,*7 S Y=-1 Q
F Q:X'[" " S X=$P(X," ")_$P(X," ",2,99)
S C=+X,X=$P(X,+X,2)
I $E(X)="Y",$G(AMQQCOMP)["CDOB" W " (",C,$S(C=1:"st",C=2:"nd",C=3:"rd",1:"th")," BIRTHDAY)"
I $L(X),"DWMY"[$E(X) S %=$E(X),Y=C*$S(%="D":1,%="W":7,%="M":30.44,1:365.25),Y=Y\1,Y=F_Y Q
D1 W " ??",*7
S Y=-1
Q
;
SET S AMQQFROU=$P(AMQQCOMP,U,3)_"^AMQQF1"
S AMQQCOMP=$P(AMQQCOMP,U)_";"_$P(AMQQCOMP,U,2)_";"_$P(AMQQCOMP,U,4)
Q
;
HELPD W !!,"Enter a time period like ""6 MONTHS"" or ""30 DAYS"" or ""2 YEARS""",!!
Q
;
HELPA W !!,"Enter a baseline age like ""3 YEARS"" or ""18 MONTHS""",!!
Q
;
HELPD1 W !!,"Enter a time period relative to the ",$S($D(AMQQSQRD):"visit",1:"baseline age"),".",!
W "For example, ""+3 YEARS"" includes a time period 3 years beyond the ",$S($D(AMQQSQRD):"visit",1:"baseline age"),".",!
W "Similarly, ""-18 MONTHS"" includes the 18 month period before the ",$S($D(AMQQSQRD):"visit",1:"baseline age"),".",!!
Q
;
EN1 ; ENTRY POINT FOR VISITS
W !!,"You can specify a time window relative to the visit date.",!!
R4RS W "Enter the start of the time window relative to the visit: "
S Z="1^R4RS^R4RE^1"
D RG
G @AMQQDEST
R4RE W !,"Enter the end of the time window relative to the visit: "
S Z="2^R4RE^R3CK^1"
D RG
G @AMQQDEST
R4CK I +AMQQCOMP'<$P(AMQQCOMP,U,2) W " ??",*7 G R4RS
D SET
Q
;
AMQQAVR ; IHS/CMI/THL - RELATIVE DATE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
TYPE WRITE !,"Relative to what date =>",!!
+1 SET %="DATE OF BIRTH^DATE OF DEATH^A PARTICULAR AGE"
+2 FOR I=1:1
SET Y=$PIECE(%,U,I)
IF Y=""
QUIT
WRITE ?3,I,") ",Y,!
RT WRITE !,"Your choice (1-",I-1,"): 1// "
+1 READ X:DTIME
IF '$TEST
SET X=U
+2 IF X=""
SET X=1
WRITE " (1)"
+3 IF X?1."?"
WRITE !!!,"Results are screened by comparing the date of result with the ""relative"" date",!!
GOTO RT
+4 IF $EXTRACT(X)=U
SET AMQQQUIT=""
GOTO EXIT
+5 IF X?1N
IF X<I
DO @("R"_X)
GOTO EXIT
+6 WRITE " ??",*7
+7 GOTO RT
+8 ;
EXIT IF $DATA(AMQQQUIT)
SET AMQQCOMP=""
+1 IF AMQQCOMP'=""
SET AMQQSQCV=AMQQCOMP
+2 KILL X,Y,%,C,F,I,Z
+3 QUIT
+4 ;
R1 ; BIRTHDAY
+1 SET AMQQCOMP="0^0^CDOB"
+2 WRITE !
R1RS WRITE !,"Time window begins how long after patient's birth: "
+1 SET Z="1^R1RS^R1RE"
+2 DO RG
+3 GOTO @AMQQDEST
R1RE WRITE !,"The window ends how long after birth: "
+1 SET Z="2^R1RE^R1CK"
+2 DO RG
+3 GOTO @AMQQDEST
R1CK IF +AMQQCOMP'<$PIECE(AMQQCOMP,U,2)
WRITE " ??",*7
GOTO R1
+1 DO SET
+2 QUIT
+3 ;
R2 ; DEATHDAY
+1 SET AMQQCOMP="0^0^CDOD"
WRITE !
R2RS WRITE !,"The window of time begins how long before each patient's death: "
+1 SET Z="1^R2RS^R2RE"
+2 DO RG
+3 GOTO @AMQQDEST
R2RE WRITE !,"The window ends how long before death: "
+1 SET Z="2^R1RE^R2CK"
+2 DO RG
+3 GOTO @AMQQDEST
R2CK IF $PIECE(AMQQCOMP,U,2)'<+AMQQCOMP
WRITE " ??",*7
GOTO R2
+1 DO SET
+2 QUIT
+3 ;
R3 ; AGE
+1 WRITE !
SET AMQQCOMP="0^0^CAGE"
+2 WRITE !,"Enter the baseline age: "
+3 READ X:DTIME
IF '$TEST
SET X=U
+4 IF U[$EXTRACT(X)
SET AMQQQUIT=""
QUIT
+5 IF X?1."?"
DO HELPA
GOTO R3
+6 IF X=""
SET AMQQCOMP=""
QUIT
+7 IF X?1.N
SET X=X_"Y"
IF $GET(AMQQCOMP)'["CDOB"
WRITE " (years)"
+8 SET F=""
+9 DO DATE
+10 IF Y=-1
GOTO R3
+11 SET $PIECE(AMQQCOMP,U,4)=Y
R3RS WRITE !,"Enter beginning of time window relative to each patient's age: "
+1 SET Z="1^R3RS^R3RE^1"
+2 DO RG
+3 GOTO @AMQQDEST
R3RE WRITE !,"Enter the end of the time window relative to the baseline age: "
+1 SET Z="2^R3RE^R3CK^1"
+2 DO RG
+3 GOTO @AMQQDEST
R3CK IF +AMQQCOMP'<$PIECE(AMQQCOMP,U,2)
WRITE " ??",*7
GOTO R3
+1 DO SET
+2 QUIT
+3 ;
RG READ X:DTIME
IF '$TEST
SET X=U
+1 IF X=""
SET X=$SELECT(+Z=1:"0D",1:"999999D")
+2 IF X=U
SET AMQQQUIT=""
SET AMQQDEST="EXIT"
QUIT
+3 IF X?1."?"
DO @("HELPD"_$PIECE(Z,U,4))
SET AMQQDEST=$PIECE(Z,U,2)
QUIT
+4 IF X?.1P1.N
SET X=X_"Y"
IF $GET(AMQQCOMP)'["CDOB"
WRITE " (years)"
+5 SET F=""
+6 DO @("DATE"_$PIECE(Z,U,4))
+7 IF Y=-1
SET AMQQDEST=$PIECE(Z,U,2)
QUIT
+8 SET $PIECE(AMQQCOMP,U,+Z)=Y
+9 SET AMQQDEST=$PIECE(Z,U,3)
+10 QUIT
+11 ;
DATE1 SET F="+"
+1 IF $EXTRACT(X)="+"!($EXTRACT(X)="-")
SET F=$EXTRACT(X)
SET X=$EXTRACT(X,2,99)
DATE IF $EXTRACT(X)'?1N
GOTO D1
+1 IF X?1.N
WRITE !!,"You must also specify time units; e.g. 6 MONTHS or 30 YEARS",!!,*7
SET Y=-1
QUIT
+2 FOR
IF X'[" "
QUIT
SET X=$PIECE(X," ")_$PIECE(X," ",2,99)
+3 SET C=+X
SET X=$PIECE(X,+X,2)
+4 IF $EXTRACT(X)="Y"
IF $GET(AMQQCOMP)["CDOB"
WRITE " (",C,$SELECT(C=1:"st",C=2:"nd",C=3:"rd",1:"th")," BIRTHDAY)"
+5 IF $LENGTH(X)
IF "DWMY"[$EXTRACT(X)
SET %=$EXTRACT(X)
SET Y=C*$SELECT(%="D":1,%="W":7,%="M":30.44,1:365.25)
SET Y=Y\1
SET Y=F_Y
QUIT
D1 WRITE " ??",*7
+1 SET Y=-1
+2 QUIT
+3 ;
SET SET AMQQFROU=$PIECE(AMQQCOMP,U,3)_"^AMQQF1"
+1 SET AMQQCOMP=$PIECE(AMQQCOMP,U)_";"_$PIECE(AMQQCOMP,U,2)_";"_$PIECE(AMQQCOMP,U,4)
+2 QUIT
+3 ;
HELPD WRITE !!,"Enter a time period like ""6 MONTHS"" or ""30 DAYS"" or ""2 YEARS""",!!
+1 QUIT
+2 ;
HELPA WRITE !!,"Enter a baseline age like ""3 YEARS"" or ""18 MONTHS""",!!
+1 QUIT
+2 ;
HELPD1 WRITE !!,"Enter a time period relative to the ",$SELECT($DATA(AMQQSQRD):"visit",1:"baseline age"),".",!
+1 WRITE "For example, ""+3 YEARS"" includes a time period 3 years beyond the ",$SELECT($DATA(AMQQSQRD):"visit",1:"baseline age"),".",!
+2 WRITE "Similarly, ""-18 MONTHS"" includes the 18 month period before the ",$SELECT($DATA(AMQQSQRD):"visit",1:"baseline age"),".",!!
+3 QUIT
+4 ;
EN1 ; ENTRY POINT FOR VISITS
+1 WRITE !!,"You can specify a time window relative to the visit date.",!!
R4RS WRITE "Enter the start of the time window relative to the visit: "
+1 SET Z="1^R4RS^R4RE^1"
+2 DO RG
+3 GOTO @AMQQDEST
R4RE WRITE !,"Enter the end of the time window relative to the visit: "
+1 SET Z="2^R4RE^R3CK^1"
+2 DO RG
+3 GOTO @AMQQDEST
R4CK IF +AMQQCOMP'<$PIECE(AMQQCOMP,U,2)
WRITE " ??",*7
GOTO R4RS
+1 DO SET
+2 QUIT
+3 ;
