AMQQAV0 ;IHS/CMI/THL - SUBROUTINE FOR AGE, DATE, SET, NUMBER AND LOOKUP;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;-----
COMPA ; ENTRY POINT FROM AMQQAV
I AMQQNOCO>1 D COMPA2 Q
I $D(AMQQXX) G COMPA1
GETAGE R !,?(5*$D(AMQQZNM)),"Age: ",X:DTIME E S AMQQQUIT="" Q
COMPA1 I X="" Q
I X=U S AMQQQUIT="" Q
I X?1.3N S AMQQCOMP=X Q
D SPEC
I $D(AMQQCOMP) Q
I $D(AMQQXX) Q
W " ??",*7
G GETAGE
Q
;
COMPA2 I $D(AMQQXX) N Z S Z=X,X=+X G COMPN21
R !,?(5*$D(AMQQZNM)),"Start with (and include) AGE: ",X:DTIME E S AMQQQUIT="" Q
COMPA21 I X="" S AMQQCOMP=";" G A2
I X=U S AMQQQUIT="" Q
I X'?1.3N W " ??",*7 G COMPA2
S AMQQCOMP=X_";"
I $D(AMQQXX) S X=$P(Z,";",2) G A21
A2 R !,?(5*$D(AMQQZNM)),"End with (and include) AGE: ",X:DTIME E S AMQQQUIT="" Q
A21 I X="",AMQQCOMP=";" K AMQQCOMP Q
I X="" Q
I X=U S AMQQQUIT="" Q
I X'?1.3N W " ??",*7 G A2
I X<+AMQQCOMP W " ??",*7 G A2
I AMQQCOMP=";" S AMQQCOMP="0;"
S AMQQCOMP=AMQQCOMP_X
Q
;
COMPD ; ENTRY POINT FROM AMQQAV
I AMQQATNM="ALIVE" D ALIVE^AMQQAV Q
I $G(AMQQNOCO)>1 D COMPD2 Q
S %DT="AETX"
S %DT("A")="Exact date: "
I $D(AMQQADAM) S %DT="AET"
I $D(AMQQXX) S %DT="" K %DT("A")
D ^%DT
I $D(DTOUT) K DTOUT S AMQQQUIT="" Q
I X="" S X=U,AMQQQUIT="" Q
I Y'=-1,AMQQSYMB="=" S AMQQCOMP=Y_";"_Y Q
I Y'=-1,AMQQSYMB=">",Y?7N S Y=Y+.235959
I Y'=-1 S AMQQCOMP=Y Q
I X=U S AMQQQUIT=""
Q
;
COMPD2 I '$D(AMQQXX) G COMPD29
N Z
S Z=X
S X=$P(X,";")
S %DT=""
D ^%DT
G COMPD21
COMPD29 S %DT="AETX"
S %DT("A")="Exact starting date: "
S:$D(AMQQADAM) %DT="ATE"
D ^%DT
COMPD21 I $D(DTOUT) K DTOUT S AMQQQUIT="" Q
I X="" S AMQQCOMP=";" G D2
I X=U S AMQQQUIT="" Q
S AMQQCOMP=Y_";"
I $D(AMQQXX) S X=$P(Z,";",2),%DT="" D ^%DT G D21
D2 S %DT("A")="Exact ending date: "
D ^%DT
D21 I $D(DTOUT) K DTOUT S AMQQQUIT="" Q
I X="",AMQQCOMP=";" S AMQQCOMP="0;"_DT Q
I X="" Q
I X=U S AMQQQUIT="" Q
I Y<+AMQQCOMP W " ??",*7 G COMPD2
I Y?7N S Y=Y+.235959
S AMQQCOMP=AMQQCOMP_Y
Q
;
;
COMPS ;ENTRY POINT FROM AMQQAV
N AMQQSSS
S X=$P(^AMQQ(1,AMQQLINK,0),U,6)
I X="",AMQQLINK>1000 S %=$G(^AMQQ(1,AMQQLINK,4,1,1)) S %=$P(%,"S Y=",2) S %=$P(%,""",X=$F") S AMQQSSS=% G COMPSXX
S Y=+X
S Z=$P(X,",",2)
S AMQQSSS=";"_$P(^DD(Y,Z,0),U,3)
COMPSXX I $D(AMQQXX),$D(AMQQXXVV) S X=AMQQXXVV G COMPSA
I $D(AMQQXX),$D(AMQQNVAL) S X=AMQQNVAL G COMPSA
COMPSR R !,?(5*$D(AMQQZNM)),"Value: ",X:DTIME E S AMQQQUIT="" Q
I X=U S AMQQQUIT="" Q
I X?1."?" W !,"CHOOSE FROM: " F I=2:1 S A=$P(AMQQSSS,";",I) G:A="" COMPS W !,?7,$P(A,":"),?15,$P(A,":",2)
I X="" D ACA^AMQQAC
I X="" W !! K AMQQCOND Q
COMPSA K AMQQCOMP
I $G(AMQQLINK)=758 D
.I X S ^UTILITY("AMQQ TAX",$J,-999999999,X)="" Q
.I X="ALL" N I,J F I=2:1 S J=+$P(AMQQSSS,";",I) Q:'J S ^UTILITY("AMQQ TAX",$J,-999999999,J)=""
S A=";"_X_":"
S A=$F(AMQQSSS,A)
I A D Q
.S AMQQCOMP=$S($G(^AMQQ(1,+$G(AMQQLINK),1))'["AUPNVXAM"&($G(^(1))'["AUPNVNTS"):X,1:$S(X="A":1,1:0)) ;PATCH XXX
.W:'$D(AMQQXX) " ",$P($E(AMQQSSS,A,99),";")
F I=2:1 S A=$P(AMQQSSS,";",I) Q:A="" S B=$P(A,":",2),C=$P(A,":") I $E(B,1,$L(X))=X S AMQQCOMP=C W:'$D(AMQQXX) $E(B,$L(X)+1,99) Q
I $D(AMQQCOMP) Q
D SPEC
I $D(AMQQCOMP) Q
I $D(AMQQXX) Q
W " ??",*7
G COMPSR
Q
;
COMPN ; ENTRY POINT FROM AMQQAV
I AMQQNOCO>1 D COMPN2 Q
I $D(AMQQXX) G COMPN1
I AMQQLINK>764,AMQQLINK<768 D DAYS I 1
E W !,?(5*$D(AMQQZNM)),"Value: " R X:DTIME E S AMQQQUIT="" Q
I X?1."?" W !!,"Enter a number to be used as the comparison value.",!! G COMPN
I X=U S AMQQQUIT="" Q
I X="" Q
I $D(AMQQCCHK),AMQQCCHK'="" X AMQQCCHK G:$D(X) CN W " ??",*7 G COMPN
COMPN1 I X=+X S AMQQCOMP=X Q
D SPEC
I $D(AMQQCOMP) Q
I $D(AMQQXX) Q
W " ??",*7
G COMPN
CN S AMQQCOMP=X
Q
;
COMPN2 I $D(AMQQXX) N Z S Z=X,X=+X G COMPN21
R !,?(5*$D(AMQQZNM)),"Enter the lower limiting value: ",X:DTIME E S AMQQQUIT="" Q
COMPN21 I X="" S AMQQCOMP="" Q
I X=U S AMQQQUIT="" Q
I X?1."?" W !,"Enter a number",!!! G COMPN2
I $D(AMQQCCHK),AMQQCCHK'="" X AMQQCCHK G N:$D(X) W " ??",*7 G COMPN2
I X'=+X W " ??",*7 G COMPN2
N S AMQQCOMP=X_";"
I $D(AMQQXX) S X=$P(Z,";",2) G N21
N2 R !,?(5*$D(AMQQZNM)),"Enter the upper limiting value: ",X:DTIME E S AMQQQUIT="" Q
N21 I X="" S AMQQCOMP="" Q
I X?1."?" W !,"Enter a number",!!! G N2
I X=U S AMQQQUIT="" Q
I $D(AMQQCCHK),AMQQCCHK'="" X AMQQCCHK G:$D(X) CN2 W " ??",*7 G N2
I X'=+X!(X<+AMQQCOMP) W " ??",*7 G COMPN2
CN2 S AMQQCOMP=AMQQCOMP_X
Q
;
SPEC I X="*" S X="EXISTS" W " (List all values)"
K AMQQCOMP
S Z="ANY;SAVE;ALL;EXISTS;BLANK;EMPTY;NULL;@"
F I=1:1 S %=$P(Z,";",I) Q:%="" I X=$E(%,1,$L(X)) W $E(%,$L(X)+1,99) S X=% D S1 Q
Q
;
S1 I $D(AMQQMULT) Q
I I>2,$E(X,1,4)="NOT " S I=$S(I>4:4,1:5)
S X=$S(I>4:"NULL",I>2:"EXISTS",I=1:"ANY",1:"SAVE")
I X="ANY" D ANY^AMQQAC
S AMQQSYMB="'="
S AMQQCOMP=";;;"_$S($G(AMQQLINK)'=758:X,1:"")
Q
;-----
DAYS ;EP;
;SPECIAL CONDITION PROCESSING FOR BREAST FEEDING STOPPED,
;FORMULA STARTED, ... ATTRIBUTES
W !!,"Enter the number of 'D'ays, 'W'eeks, 'M'onths or 'Y'ears in the format:"
W !?5,"4D for 4 days, or 3M for 3 months, etc.,"
W !?5,"to use in the ",AMQQATNM,$S(AMQQATNM["STA":" on or after",1:" on or before")," query."
W !!,?(5*$D(AMQQZNM)),"Value: "
R X:DTIME E S AMQQQUIT="" Q
I X[U S AMQQQUIT="" Q
D INP^AUPNCIX
S:$G(X)="" X=""
W !
S X=$$CONVDAYS^AUPNCIX(X)
S X=X+1
Q
AMQQAV0 ;IHS/CMI/THL - SUBROUTINE FOR AGE, DATE, SET, NUMBER AND LOOKUP;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;-----
COMPA ; ENTRY POINT FROM AMQQAV
+1 IF AMQQNOCO>1
DO COMPA2
QUIT
+2 IF $DATA(AMQQXX)
GOTO COMPA1
GETAGE READ !,?(5*$DATA(AMQQZNM)),"Age: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
COMPA1 IF X=""
QUIT
+1 IF X=U
SET AMQQQUIT=""
QUIT
+2 IF X?1.3N
SET AMQQCOMP=X
QUIT
+3 DO SPEC
+4 IF $DATA(AMQQCOMP)
QUIT
+5 IF $DATA(AMQQXX)
QUIT
+6 WRITE " ??",*7
+7 GOTO GETAGE
+8 QUIT
+9 ;
COMPA2 IF $DATA(AMQQXX)
NEW Z
SET Z=X
SET X=+X
GOTO COMPN21
+1 READ !,?(5*$DATA(AMQQZNM)),"Start with (and include) AGE: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
COMPA21 IF X=""
SET AMQQCOMP=";"
GOTO A2
+1 IF X=U
SET AMQQQUIT=""
QUIT
+2 IF X'?1.3N
WRITE " ??",*7
GOTO COMPA2
+3 SET AMQQCOMP=X_";"
+4 IF $DATA(AMQQXX)
SET X=$PIECE(Z,";",2)
GOTO A21
A2 READ !,?(5*$DATA(AMQQZNM)),"End with (and include) AGE: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
A21 IF X=""
IF AMQQCOMP=";"
KILL AMQQCOMP
QUIT
+1 IF X=""
QUIT
+2 IF X=U
SET AMQQQUIT=""
QUIT
+3 IF X'?1.3N
WRITE " ??",*7
GOTO A2
+4 IF X<+AMQQCOMP
WRITE " ??",*7
GOTO A2
+5 IF AMQQCOMP=";"
SET AMQQCOMP="0;"
+6 SET AMQQCOMP=AMQQCOMP_X
+7 QUIT
+8 ;
COMPD ; ENTRY POINT FROM AMQQAV
+1 IF AMQQATNM="ALIVE"
DO ALIVE^AMQQAV
QUIT
+2 IF $GET(AMQQNOCO)>1
DO COMPD2
QUIT
+3 SET %DT="AETX"
+4 SET %DT("A")="Exact date: "
+5 IF $DATA(AMQQADAM)
SET %DT="AET"
+6 IF $DATA(AMQQXX)
SET %DT=""
KILL %DT("A")
+7 DO ^%DT
+8 IF $DATA(DTOUT)
KILL DTOUT
SET AMQQQUIT=""
QUIT
+9 IF X=""
SET X=U
SET AMQQQUIT=""
QUIT
+10 IF Y'=-1
IF AMQQSYMB="="
SET AMQQCOMP=Y_";"_Y
QUIT
+11 IF Y'=-1
IF AMQQSYMB=">"
IF Y?7N
SET Y=Y+.235959
+12 IF Y'=-1
SET AMQQCOMP=Y
QUIT
+13 IF X=U
SET AMQQQUIT=""
+14 QUIT
+15 ;
COMPD2 IF '$DATA(AMQQXX)
GOTO COMPD29
+1 NEW Z
+2 SET Z=X
+3 SET X=$PIECE(X,";")
+4 SET %DT=""
+5 DO ^%DT
+6 GOTO COMPD21
COMPD29 SET %DT="AETX"
+1 SET %DT("A")="Exact starting date: "
+2 IF $DATA(AMQQADAM)
SET %DT="ATE"
+3 DO ^%DT
COMPD21 IF $DATA(DTOUT)
KILL DTOUT
SET AMQQQUIT=""
QUIT
+1 IF X=""
SET AMQQCOMP=";"
GOTO D2
+2 IF X=U
SET AMQQQUIT=""
QUIT
+3 SET AMQQCOMP=Y_";"
+4 IF $DATA(AMQQXX)
SET X=$PIECE(Z,";",2)
SET %DT=""
DO ^%DT
GOTO D21
D2 SET %DT("A")="Exact ending date: "
+1 DO ^%DT
D21 IF $DATA(DTOUT)
KILL DTOUT
SET AMQQQUIT=""
QUIT
+1 IF X=""
IF AMQQCOMP=";"
SET AMQQCOMP="0;"_DT
QUIT
+2 IF X=""
QUIT
+3 IF X=U
SET AMQQQUIT=""
QUIT
+4 IF Y<+AMQQCOMP
WRITE " ??",*7
GOTO COMPD2
+5 IF Y?7N
SET Y=Y+.235959
+6 SET AMQQCOMP=AMQQCOMP_Y
+7 QUIT
+8 ;
+9 ;
COMPS ;ENTRY POINT FROM AMQQAV
+1 NEW AMQQSSS
+2 SET X=$PIECE(^AMQQ(1,AMQQLINK,0),U,6)
+3 IF X=""
IF AMQQLINK>1000
SET %=$GET(^AMQQ(1,AMQQLINK,4,1,1))
SET %=$PIECE(%,"S Y=",2)
SET %=$PIECE(%,""",X=$F")
SET AMQQSSS=%
GOTO COMPSXX
+4 SET Y=+X
+5 SET Z=$PIECE(X,",",2)
+6 SET AMQQSSS=";"_$PIECE(^DD(Y,Z,0),U,3)
COMPSXX IF $DATA(AMQQXX)
IF $DATA(AMQQXXVV)
SET X=AMQQXXVV
GOTO COMPSA
+1 IF $DATA(AMQQXX)
IF $DATA(AMQQNVAL)
SET X=AMQQNVAL
GOTO COMPSA
COMPSR READ !,?(5*$DATA(AMQQZNM)),"Value: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
+1 IF X=U
SET AMQQQUIT=""
QUIT
+2 IF X?1."?"
WRITE !,"CHOOSE FROM: "
FOR I=2:1
SET A=$PIECE(AMQQSSS,";",I)
IF A=""
GOTO COMPS
WRITE !,?7,$PIECE(A,":"),?15,$PIECE(A,":",2)
+3 IF X=""
DO ACA^AMQQAC
+4 IF X=""
WRITE !!
KILL AMQQCOND
QUIT
COMPSA KILL AMQQCOMP
+1 IF $GET(AMQQLINK)=758
Begin DoDot:1
+2 IF X
SET ^UTILITY("AMQQ TAX",$JOB,-999999999,X)=""
QUIT
+3 IF X="ALL"
NEW I,J
FOR I=2:1
SET J=+$PIECE(AMQQSSS,";",I)
IF 'J
QUIT
SET ^UTILITY("AMQQ TAX",$JOB,-999999999,J)=""
End DoDot:1
+4 SET A=";"_X_":"
+5 SET A=$FIND(AMQQSSS,A)
+6 IF A
Begin DoDot:1
+7 ;PATCH XXX
SET AMQQCOMP=$SELECT($GET(^AMQQ(1,+$GET(AMQQLINK),1))'["AUPNVXAM"&($GET(^(1))'["AUPNVNTS"):X,1:$SELECT(X="A":1,1:0))
+8 IF '$DATA(AMQQXX)
WRITE " ",$PIECE($EXTRACT(AMQQSSS,A,99),";")
End DoDot:1
QUIT
+9 FOR I=2:1
SET A=$PIECE(AMQQSSS,";",I)
IF A=""
QUIT
SET B=$PIECE(A,":",2)
SET C=$PIECE(A,":")
IF $EXTRACT(B,1,$LENGTH(X))=X
SET AMQQCOMP=C
IF '$DATA(AMQQXX)
WRITE $EXTRACT(B,$LENGTH(X)+1,99)
QUIT
+10 IF $DATA(AMQQCOMP)
QUIT
+11 DO SPEC
+12 IF $DATA(AMQQCOMP)
QUIT
+13 IF $DATA(AMQQXX)
QUIT
+14 WRITE " ??",*7
+15 GOTO COMPSR
+16 QUIT
+17 ;
COMPN ; ENTRY POINT FROM AMQQAV
+1 IF AMQQNOCO>1
DO COMPN2
QUIT
+2 IF $DATA(AMQQXX)
GOTO COMPN1
+3 IF AMQQLINK>764
IF AMQQLINK<768
DO DAYS
IF 1
+4 IF '$TEST
WRITE !,?(5*$DATA(AMQQZNM)),"Value: "
READ X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
+5 IF X?1."?"
WRITE !!,"Enter a number to be used as the comparison value.",!!
GOTO COMPN
+6 IF X=U
SET AMQQQUIT=""
QUIT
+7 IF X=""
QUIT
+8 IF $DATA(AMQQCCHK)
IF AMQQCCHK'=""
XECUTE AMQQCCHK
IF $DATA(X)
GOTO CN
WRITE " ??",*7
GOTO COMPN
COMPN1 IF X=+X
SET AMQQCOMP=X
QUIT
+1 DO SPEC
+2 IF $DATA(AMQQCOMP)
QUIT
+3 IF $DATA(AMQQXX)
QUIT
+4 WRITE " ??",*7
+5 GOTO COMPN
CN SET AMQQCOMP=X
+1 QUIT
+2 ;
COMPN2 IF $DATA(AMQQXX)
NEW Z
SET Z=X
SET X=+X
GOTO COMPN21
+1 READ !,?(5*$DATA(AMQQZNM)),"Enter the lower limiting value: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
COMPN21 IF X=""
SET AMQQCOMP=""
QUIT
+1 IF X=U
SET AMQQQUIT=""
QUIT
+2 IF X?1."?"
WRITE !,"Enter a number",!!!
GOTO COMPN2
+3 IF $DATA(AMQQCCHK)
IF AMQQCCHK'=""
XECUTE AMQQCCHK
IF $DATA(X)
GOTO N
WRITE " ??",*7
GOTO COMPN2
+4 IF X'=+X
WRITE " ??",*7
GOTO COMPN2
N SET AMQQCOMP=X_";"
+1 IF $DATA(AMQQXX)
SET X=$PIECE(Z,";",2)
GOTO N21
N2 READ !,?(5*$DATA(AMQQZNM)),"Enter the upper limiting value: ",X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
N21 IF X=""
SET AMQQCOMP=""
QUIT
+1 IF X?1."?"
WRITE !,"Enter a number",!!!
GOTO N2
+2 IF X=U
SET AMQQQUIT=""
QUIT
+3 IF $DATA(AMQQCCHK)
IF AMQQCCHK'=""
XECUTE AMQQCCHK
IF $DATA(X)
GOTO CN2
WRITE " ??",*7
GOTO N2
+4 IF X'=+X!(X<+AMQQCOMP)
WRITE " ??",*7
GOTO COMPN2
CN2 SET AMQQCOMP=AMQQCOMP_X
+1 QUIT
+2 ;
SPEC IF X="*"
SET X="EXISTS"
WRITE " (List all values)"
+1 KILL AMQQCOMP
+2 SET Z="ANY;SAVE;ALL;EXISTS;BLANK;EMPTY;NULL;@"
+3 FOR I=1:1
SET %=$PIECE(Z,";",I)
IF %=""
QUIT
IF X=$EXTRACT(%,1,$LENGTH(X))
WRITE $EXTRACT(%,$LENGTH(X)+1,99)
SET X=%
DO S1
QUIT
+4 QUIT
+5 ;
S1 IF $DATA(AMQQMULT)
QUIT
+1 IF I>2
IF $EXTRACT(X,1,4)="NOT "
SET I=$SELECT(I>4:4,1:5)
+2 SET X=$SELECT(I>4:"NULL",I>2:"EXISTS",I=1:"ANY",1:"SAVE")
+3 IF X="ANY"
DO ANY^AMQQAC
+4 SET AMQQSYMB="'="
+5 SET AMQQCOMP=";;;"_$SELECT($GET(AMQQLINK)'=758:X,1:"")
+6 QUIT
+7 ;-----
DAYS ;EP;
+1 ;SPECIAL CONDITION PROCESSING FOR BREAST FEEDING STOPPED,
+2 ;FORMULA STARTED, ... ATTRIBUTES
+3 WRITE !!,"Enter the number of 'D'ays, 'W'eeks, 'M'onths or 'Y'ears in the format:"
+4 WRITE !?5,"4D for 4 days, or 3M for 3 months, etc.,"
+5 WRITE !?5,"to use in the ",AMQQATNM,$SELECT(AMQQATNM["STA":" on or after",1:" on or before")," query."
+6 WRITE !!,?(5*$DATA(AMQQZNM)),"Value: "
+7 READ X:DTIME
IF '$TEST
SET AMQQQUIT=""
QUIT
+8 IF X[U
SET AMQQQUIT=""
QUIT
+9 DO INP^AUPNCIX
+10 IF $GET(X)=""
SET X=""
+11 WRITE !
+12 SET X=$$CONVDAYS^AUPNCIX(X)
+13 SET X=X+1
+14 QUIT
