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