AMQQN0 ; IHS/CMI/THL - NATL LANGUAGE PRELIMINARY SETUP ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
PREP F %=" DURING "," IN " I X[% D DUR Q
I X[" BORN " D BORN
I X'[" BETWEEN " F Q:X'[" AND " S X=$P(X," AND ")_" &"_$P(X," AND ",2,99)
I X["&" D AND G EXIT
I X["BETWEEN" S %=$P(X,"BETWEEN",2) I %[" AND " S AMQQNV2=$P(X," AND ",2),X=$P(X,(" AND "_AMQQNV2))
RUN D SPEC
D STRIP
D UNITS
D PRELIM
EXIT K Y
Q
;
SPEC N A,B,C,%,N,I
I ($E(X,1,6)="WOMEN "!($E(X,1,6)="WOMEN")),X'["CHILD" S X="FEMALES "_$E(X,7,999)
S %="PTS'^CLIENTS'^CLIENT'S^EVERYONE'S^EVERYBODY'S^PTS^CLIENTS^EVERYONE^EVERYBODY^PEOPLE^FOLKS"
F I=1:1 S A=$P(%,U,I) Q:A="" S A=A_" " I X[A S X=$P(X,A)_"PATIENTS "_$P(X,A,2) Q
F %=" WHO ARE "," WHO IS "," WHO WERE " F Q:X'[% S X=$P(X,%)_" "_$P(X,%,2,99)
S %=" WHO HAVE "
I X[% S X=$P(X,%)_" WITH "_$P(X,%,2)
S %="ALL OF "
I X[% S X=$P(X,%)_"ALL "_$P(X,%,2)
I X'["AGE" G SP1
S %=" THE AGE OF "
I X[% S X=$P(X,%)_" AGE "_$P(X,%,2)
S %="ABOVE^GREATER THAN^MORE THAN^OVER^BEYOND^>^LESS THAN^BELOW^HIGHER THAN^UNDER^<"
F I=1:1 S A=$P(%,U,I) Q:A="" S Y=" "_A_" AGE " I X[Y S X=$P(X,Y)_" AGE "_A_" "_$P(X,Y,2) Q
SP1 S %=" WITH "
I X[%,$L($P(X,%,2)," ")<3 S X=$P(X,%)_" DX OF "_$P(X,%,2)
F %="WHAT IS ","WHAT WAS " I X[% S X=$P(X,%)_$P(X,%,2,99)
S %=" OF "
I X["PATIENT" F Q:X'[% S X=$P(X,%,1)_" = "_$P(X,%,2,99)
S %="FROM^LIVING IN^LIVE IN^LIVES IN"
F I=1:1 S A=$P(%,U,I) Q:A="" S A=" "_A_" " I X[A S X=$P(X,A)_" CURRENT COMMUNITY = "_$P(X,A,2) Q
S %="WHO ARE TAKING^WHO TAKE^TAKING^ON"
F I=1:1 S A=$P(%,U,I) Q:A="" S A=" "_A_" " I X[A S X=$P(X,A)_" RX = "_$P(X,A,2) Q
I X'["DEAD" Q
F I=1:1 S A=$P(X," ",I) I A="DEAD" S X="PATIENTS WHO DIED AFTER 1800" Q
Q
;
STRIP S Y(1)=";SEE;GIVE;FIND;PRINT;LIST;GET;SHOW;I;ME;FOR;DISPLAY;TO;WANT;WOULD;LIKE;NEED;REQUEST;ALL;LET;VIEW;SEARCH;WHAT;KNOW;A;AN;TELL;MUCH;DOES;"
S Y(2)=";THE;THEIR;THAN;REPORT;LIST;LISTING;BRING;WHOSE;WHO;EVERY;PRINT;MAKE;EVERY;EACH;WITH;FIND;NOW;HIS;HER;A;YOU;COULD;PLEASE;"
STP F Q:X'["." S %=$E(X,$F(X,".")) S X=$P(X,".")_$S(%=+%:"~~~",1:"")_$P(X,".",2,99)
F Q:X'["~~~" S X=$P(X,"~~~")_"."_$P(X,"~~~",2,99)
F I=1:1 S Z=$P(X," ",I) Q:Z="" F J=0:0 S J=$O(Y(J)) Q:'J D ST1
Q
;
ST1 I I=1,Y(J)[(";"_Z_";") S X=$P(X," ",2,99),I=I-1,J=99 Q
I Y(J)[(";"_Z_";") S X=$P(X," ",1,I-1)_" "_$P(X," ",I+1,99),I=I-1,J=99
Q
;
UNITS N %,Y,Z
F %="WEIGH","WT" I X[% F Y="LBS.","lbs.","LBS","lbs","POUNDS","LB.","LB","lb.","lb" I X[Y S Z="WTL" D INSERT G UXIT
F %="WEIGH","WT" I X[% F Y="KBS.","kgs.","KGS","kgs","KILOGRAMS","KG.","KG","kg.","kg" I X[Y S Z="WTK" D INSERT G UXIT
F %="HEIGH","HT" I X[% F Y="INS.","ins.","INS","ins","INCHES","IN.","IN","in.","in" I X[Y S Z="HTI" D INSERT G UXIT
F %="HEIGH","HT" I X[% F Y="CMS.","cms.","CMS","cms","CENTIMETERS","CM.","CM","cm.","cm" I X[Y S Z="HTC" D INSERT G UXIT
UXIT Q
;
PRELIM F Q:X'[" " S X=$P(X," ")_S_$P(X," ",2,99)
I $E(X)=" " S X=$E(X,2,999)
I $E(X,$L(X))=" " S X=$E(X,1,$L(X)-1)
Q
;
INSERT N A,B
S A=$P(X,%)
S B=$P(X,%,2)
S B=$P(B," ",2,99)
S X=A_Z_" "_B
Q
;
AND F I=1:1 S %=$P(X,"&",I) Q:%="" S AMQQNAP(I)=%
F AMQQNAP=0:0 S AMQQNAP=$O(AMQQNAP(AMQQNAP)) Q:'AMQQNAP S X=AMQQNAP(AMQQNAP) D RUN S AMQQNAP(AMQQNAP)=X
S X=AMQQNAP(1)
Q
;
BORN S %=" BORN ON "
I X[% S X=$P(X,%)_" DOB = "_$P(X,%,2) Q
S %=" BORN DURING "
I X[% D IN Q
S %=" BORN IN "
I X[% D IN Q
S %=" BORN "
I X[% S X=$P(X,%)_" DOB "_$P(X,%,2)
Q
;
IN S A=$P(X,%,2)
I A'?4N Q
S X=$P(X,%)_" DOB BETWEEN "_A_" AND "_(A+1)
Q
;
DUR N Y,Z,A,B,C
S Y=$P(X,%,2)
S C=%
I Y?1.2N S Y=$$YEAR^AMQQN0(Y) ;Y2000
I Y?4N S X=$P(X,%)_" BETWEEN 1/1/"_Y_" AND 12/31/"_Y Q
D DUR1
I Y=-1 Q
I $E(Y,6,7)'="00" Q
S A=$E(Y,1,3)+1700
S A=+$E(Y,4,5)_"/1/"_A
S Z=+$E(Y,4,5)
S Z=$E("303232332323",Z)+28
S B=+$E(Y,4,5)_"/"_Z_"/"_($E(Y,1,3)+1700)
S X=$P(X,%)_" BETWEEN "_A_" AND "_B
Q
;
DUR1 N X,%
S X=Y
S %DT=""
D ^%DT
Q
;
YEAR(X) ;EP - CONVERTS 2 DIGIT YEAR INTO A FOUR DIGIT YEAR
N Y,%,%DT
S:$L(X)<2 X="0"_X ;Y2000
S %DT="P"
D ^%DT
Q Y\10000+1700 ;Y2000
;
AMQQN0 ; IHS/CMI/THL - NATL LANGUAGE PRELIMINARY SETUP ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
PREP FOR %=" DURING "," IN "
IF X[%
DO DUR
QUIT
+1 IF X[" BORN "
DO BORN
+2 IF X'[" BETWEEN "
FOR
IF X'[" AND "
QUIT
SET X=$PIECE(X," AND ")_" &"_$PIECE(X," AND ",2,99)
+3 IF X["&"
DO AND
GOTO EXIT
+4 IF X["BETWEEN"
SET %=$PIECE(X,"BETWEEN",2)
IF %[" AND "
SET AMQQNV2=$PIECE(X," AND ",2)
SET X=$PIECE(X,(" AND "_AMQQNV2))
RUN DO SPEC
+1 DO STRIP
+2 DO UNITS
+3 DO PRELIM
EXIT KILL Y
+1 QUIT
+2 ;
SPEC NEW A,B,C,%,N,I
+1 IF ($EXTRACT(X,1,6)="WOMEN "!($EXTRACT(X,1,6)="WOMEN"))
IF X'["CHILD"
SET X="FEMALES "_$EXTRACT(X,7,999)
+2 SET %="PTS'^CLIENTS'^CLIENT'S^EVERYONE'S^EVERYBODY'S^PTS^CLIENTS^EVERYONE^EVERYBODY^PEOPLE^FOLKS"
+3 FOR I=1:1
SET A=$PIECE(%,U,I)
IF A=""
QUIT
SET A=A_" "
IF X[A
SET X=$PIECE(X,A)_"PATIENTS "_$PIECE(X,A,2)
QUIT
+4 FOR %=" WHO ARE "," WHO IS "," WHO WERE "
FOR
IF X'[%
QUIT
SET X=$PIECE(X,%)_" "_$PIECE(X,%,2,99)
+5 SET %=" WHO HAVE "
+6 IF X[%
SET X=$PIECE(X,%)_" WITH "_$PIECE(X,%,2)
+7 SET %="ALL OF "
+8 IF X[%
SET X=$PIECE(X,%)_"ALL "_$PIECE(X,%,2)
+9 IF X'["AGE"
GOTO SP1
+10 SET %=" THE AGE OF "
+11 IF X[%
SET X=$PIECE(X,%)_" AGE "_$PIECE(X,%,2)
+12 SET %="ABOVE^GREATER THAN^MORE THAN^OVER^BEYOND^>^LESS THAN^BELOW^HIGHER THAN^UNDER^<"
+13 FOR I=1:1
SET A=$PIECE(%,U,I)
IF A=""
QUIT
SET Y=" "_A_" AGE "
IF X[Y
SET X=$PIECE(X,Y)_" AGE "_A_" "_$PIECE(X,Y,2)
QUIT
SP1 SET %=" WITH "
+1 IF X[%
IF $LENGTH($PIECE(X,%,2)," ")<3
SET X=$PIECE(X,%)_" DX OF "_$PIECE(X,%,2)
+2 FOR %="WHAT IS ","WHAT WAS "
IF X[%
SET X=$PIECE(X,%)_$PIECE(X,%,2,99)
+3 SET %=" OF "
+4 IF X["PATIENT"
FOR
IF X'[%
QUIT
SET X=$PIECE(X,%,1)_" = "_$PIECE(X,%,2,99)
+5 SET %="FROM^LIVING IN^LIVE IN^LIVES IN"
+6 FOR I=1:1
SET A=$PIECE(%,U,I)
IF A=""
QUIT
SET A=" "_A_" "
IF X[A
SET X=$PIECE(X,A)_" CURRENT COMMUNITY = "_$PIECE(X,A,2)
QUIT
+7 SET %="WHO ARE TAKING^WHO TAKE^TAKING^ON"
+8 FOR I=1:1
SET A=$PIECE(%,U,I)
IF A=""
QUIT
SET A=" "_A_" "
IF X[A
SET X=$PIECE(X,A)_" RX = "_$PIECE(X,A,2)
QUIT
+9 IF X'["DEAD"
QUIT
+10 FOR I=1:1
SET A=$PIECE(X," ",I)
IF A="DEAD"
SET X="PATIENTS WHO DIED AFTER 1800"
QUIT
+11 QUIT
+12 ;
STRIP SET Y(1)=";SEE;GIVE;FIND;PRINT;LIST;GET;SHOW;I;ME;FOR;DISPLAY;TO;WANT;WOULD;LIKE;NEED;REQUEST;ALL;LET;VIEW;SEARCH;WHAT;KNOW;A;AN;TELL;MUCH;DOES;"
+1 SET Y(2)=";THE;THEIR;THAN;REPORT;LIST;LISTING;BRING;WHOSE;WHO;EVERY;PRINT;MAKE;EVERY;EACH;WITH;FIND;NOW;HIS;HER;A;YOU;COULD;PLEASE;"
STP FOR
IF X'["."
QUIT
SET %=$EXTRACT(X,$FIND(X,"."))
SET X=$PIECE(X,".")_$SELECT(%=+%:"~~~",1:"")_$PIECE(X,".",2,99)
+1 FOR
IF X'["~~~"
QUIT
SET X=$PIECE(X,"~~~")_"."_$PIECE(X,"~~~",2,99)
+2 FOR I=1:1
SET Z=$PIECE(X," ",I)
IF Z=""
QUIT
FOR J=0:0
SET J=$ORDER(Y(J))
IF 'J
QUIT
DO ST1
+3 QUIT
+4 ;
ST1 IF I=1
IF Y(J)[(";"_Z_";")
SET X=$PIECE(X," ",2,99)
SET I=I-1
SET J=99
QUIT
+1 IF Y(J)[(";"_Z_";")
SET X=$PIECE(X," ",1,I-1)_" "_$PIECE(X," ",I+1,99)
SET I=I-1
SET J=99
+2 QUIT
+3 ;
UNITS NEW %,Y,Z
+1 FOR %="WEIGH","WT"
IF X[%
FOR Y="LBS.","lbs.","LBS","lbs","POUNDS","LB.","LB","lb.","lb"
IF X[Y
SET Z="WTL"
DO INSERT
GOTO UXIT
+2 FOR %="WEIGH","WT"
IF X[%
FOR Y="KBS.","kgs.","KGS","kgs","KILOGRAMS","KG.","KG","kg.","kg"
IF X[Y
SET Z="WTK"
DO INSERT
GOTO UXIT
+3 FOR %="HEIGH","HT"
IF X[%
FOR Y="INS.","ins.","INS","ins","INCHES","IN.","IN","in.","in"
IF X[Y
SET Z="HTI"
DO INSERT
GOTO UXIT
+4 FOR %="HEIGH","HT"
IF X[%
FOR Y="CMS.","cms.","CMS","cms","CENTIMETERS","CM.","CM","cm.","cm"
IF X[Y
SET Z="HTC"
DO INSERT
GOTO UXIT
UXIT QUIT
+1 ;
PRELIM FOR
IF X'[" "
QUIT
SET X=$PIECE(X," ")_S_$PIECE(X," ",2,99)
+1 IF $EXTRACT(X)=" "
SET X=$EXTRACT(X,2,999)
+2 IF $EXTRACT(X,$LENGTH(X))=" "
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+3 QUIT
+4 ;
INSERT NEW A,B
+1 SET A=$PIECE(X,%)
+2 SET B=$PIECE(X,%,2)
+3 SET B=$PIECE(B," ",2,99)
+4 SET X=A_Z_" "_B
+5 QUIT
+6 ;
AND FOR I=1:1
SET %=$PIECE(X,"&",I)
IF %=""
QUIT
SET AMQQNAP(I)=%
+1 FOR AMQQNAP=0:0
SET AMQQNAP=$ORDER(AMQQNAP(AMQQNAP))
IF 'AMQQNAP
QUIT
SET X=AMQQNAP(AMQQNAP)
DO RUN
SET AMQQNAP(AMQQNAP)=X
+2 SET X=AMQQNAP(1)
+3 QUIT
+4 ;
BORN SET %=" BORN ON "
+1 IF X[%
SET X=$PIECE(X,%)_" DOB = "_$PIECE(X,%,2)
QUIT
+2 SET %=" BORN DURING "
+3 IF X[%
DO IN
QUIT
+4 SET %=" BORN IN "
+5 IF X[%
DO IN
QUIT
+6 SET %=" BORN "
+7 IF X[%
SET X=$PIECE(X,%)_" DOB "_$PIECE(X,%,2)
+8 QUIT
+9 ;
IN SET A=$PIECE(X,%,2)
+1 IF A'?4N
QUIT
+2 SET X=$PIECE(X,%)_" DOB BETWEEN "_A_" AND "_(A+1)
+3 QUIT
+4 ;
DUR NEW Y,Z,A,B,C
+1 SET Y=$PIECE(X,%,2)
+2 SET C=%
+3 ;Y2000
IF Y?1.2N
SET Y=$$YEAR^AMQQN0(Y)
+4 IF Y?4N
SET X=$PIECE(X,%)_" BETWEEN 1/1/"_Y_" AND 12/31/"_Y
QUIT
+5 DO DUR1
+6 IF Y=-1
QUIT
+7 IF $EXTRACT(Y,6,7)'="00"
QUIT
+8 SET A=$EXTRACT(Y,1,3)+1700
+9 SET A=+$EXTRACT(Y,4,5)_"/1/"_A
+10 SET Z=+$EXTRACT(Y,4,5)
+11 SET Z=$EXTRACT("303232332323",Z)+28
+12 SET B=+$EXTRACT(Y,4,5)_"/"_Z_"/"_($EXTRACT(Y,1,3)+1700)
+13 SET X=$PIECE(X,%)_" BETWEEN "_A_" AND "_B
+14 QUIT
+15 ;
DUR1 NEW X,%
+1 SET X=Y
+2 SET %DT=""
+3 DO ^%DT
+4 QUIT
+5 ;
YEAR(X) ;EP - CONVERTS 2 DIGIT YEAR INTO A FOUR DIGIT YEAR
+1 NEW Y,%,%DT
+2 ;Y2000
IF $LENGTH(X)<2
SET X="0"_X
+3 SET %DT="P"
+4 DO ^%DT
+5 ;Y2000
QUIT Y\10000+1700
+6 ;
