Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQAV0

AMQQAV0.m

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