AMQQTXG1 ; IHS/CMI/THL - LOOKUP FOR TAX ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
PLOOKUP ; ENTRY POINT FROM AMQQTXG
S DIC=AMQQTLOK
S DIC(0)="EQM"
I $G(AMQQSQSN)=617,$G(AMQQSQN)=620 S %=$O(^UTILITY("AMQQ TAX",$J,+$G(AMQQTAX)-1,0)) I '$O(^(%)) S DIC("S")="I $D(^BWDIAG(""P"","_%_",Y))"
I $D(AMQQNECO) S DIC(0)="M"
I DIC="^AUTTHF(" S DIC("S")="I $P(^(0),U,10)=""F"""
D ^DIC
K DIC,DUOUT,DTOUT
I Y'=-1 S X=+Y I $D(AMQQTAXI),$D(AMQQTDIC),AMQQTAXI'="",AMQQTDIC'="" D PLK1
Q
;
PLK1 S:$G(AMQQLINK)=32 X=$P(Y,U,2)
I $D(AMQQTTX),AMQQTTX'="",$D(AMQQTAXT),AMQQTAXT=5 X AMQQTTX
S %=AMQQTDIC_""""_AMQQTAXI_""",X)"
I '$D(AMQQNDB),'$D(@%) W !," (none found in database so not selected... if you still want to select this",!," value enter it with quotes about it" S Y=-1
K AMQQNDBC
Q
;
PHELP ; ENTRY POINT FROM AMQQTXG
W !!,"Enter the name of a ",AMQQATNM,"."
W !,"Enter ""??"" to see your selections or ""???"" to see choices.",!!
Q
;
PHELP1 ; ENTRY POINT FROM AMQQTXG
S DIC=AMQQTLOK
S DIC(0)="E"
S D="B"
S DZ="??"
I $G(AMQQSQSN)=617,$G(AMQQSQN)=620 S %=$O(^UTILITY("AMQQ TAX",$J,+$G(AMQQTAX)-1,0)) I '$O(^(%)) S DIC("S")="I $D(^BWDIAG(""P"","_%_",Y))"
I DIC="^AUTTHF(" S DIC("S")="I $P(^(0),U,10)=""F"""
D DQ^DICQ
K DIC,D,DZ
Q
;
GLOOKUP ; ENTRY POINT FROM AMQQTXG
S Y=$F(AMQQSSET,(";"_X_":"))
I Y S Z=$E(AMQQSSET,Y,256),Z=$P(Z,";") W " (",Z,")" S Y=X Q
S Y=-1
F %=2:1 S Z=$P(AMQQSSET,";",%) Q:Z="" I $E($P(Z,":",2),1,$L(X))=X W $E($P(Z,":",2),$L(X)+1,99) S Y=$P(Z,":") Q
I Y=-1 W *7," ??" Q
S X=Y
Q
;
GHELP1 ; ENTRY POINT FROM AMQQTXG
S %="You may select one or more of the following =>"
W !!,%,!
F %=1:1 S X=$P(AMQQSSET,":",%) W !?5,$P(X,";") I $P(X,";",2)="" Q
Q
;
FHELP ; ENTRY POINT FROM AMQQTXG
I AMQQTAXI="" W !!,"Enter the name of a ",AMQQATN Q
S %="You may select one or more of the following =>"
W !!,%,!
S %=""
S X=""
S T=AMQQTDIC_""""_AMQQTAXI_""")"
F I=1:1 S %=$O(@T@(%)) Q:%="" W ! D:'(I#(IOSL-4)) FLIST1 W ?5,% I X=U Q
Q
;
FLIST1 W "<>"
R X:DTIME W *13,?5,*13
Q
;
FLOOKUP ; ENTRY POINT FROM AMQQTXG
I AMQQTAXI="" G FEXIT
S T=AMQQTDIC_""""_AMQQTAXI_""")"
I '$D(@T@(X)) S %=$O(@T@(X)) I $E(%,1,$L(X))'=X W " <= Not found in data base",*7 G FEXIT
I $D(@T@(X)) S %=$O(@T@(X)) I $E(%,1,$L(X))'=X G FEXIT
I '$D(@T@(X)) S (%,Y)=$O(@T@(X)) I $E(%,1,$L(X))=X S %=$O(^(%)) I $E(%,1,$L(X))'=X W $E(Y,$L(X)+1,99) S X=Y G FEXIT
S N=0
S Z=X
I $D(@T@(X)) S ^UTILITY("AMQQ LOOK",$J,1)=X,N=1
FINCN S Z=$O(@T@(Z))
I $E(Z,1,$L(X))'=X S N=N+1 D FC1 G:Y'=0 FEXIT G FMORE
S N=N+1
I N>1,N#5=1 D FC Q:Y=1 G:Y=-1 FEXIT I Y=0 D FEXIT G FLOOKUP
W !?5,N," ",Z
S ^UTILITY("AMQQ LOOK",$J,N)=Z
G FINCN
FMORE S AMQQLMOR=""
FEXIT K T,^UTILITY("AMQQ LOOK",$J),N
Q
;
FC W !,"TYPE <CR> TO SEE MORE CHOICES, '^' TO STOP, OR"
FC1 W !,"CHOOSE 1-",N-1,": "
R Y:DTIME E S Y=U
I Y="" Q
I Y=U S Y=-1 Q
I Y?1."?" W !,"Pick a number between 1 and ",N-1,". You can also enter a new name.",! G FC
I Y,$D(^UTILITY("AMQQ LOOK",$J,Y)) S X=^(Y) W " (",X,")" Q
I Y=+Y W " ??",*7 G FC1
S X=Y
S Y=0
Q
;
RHELP ; ENTRY POINT FROM AMQQTXG
S X="DIAG"
I AMQQLINK=31 S Z="diagnosis^diagnoses^ICD9^250.00^250.51^CAUSE or LOCATION"
I AMQQLINK=174 S Z="procedure^procedures^ADA^AAA^BBB^CCC"
I AMQQLINK=455 S Z="CPT CODE^CPT CODES^CPT^11040^11044"
D ^AMQQHEL1
Q
;
RLOOKUP ; ENTRY POINT FROM AMQQTXG
S AMQQSAVE("X")=X
S (AMQQONE,AMQQSUB,AMQQA)=0
S AMQQ("NO DISPLAY")=0
S AMQQ("NOT TAX")=""
S AMQQTYP="LOW"
I $D(AMQQTXEX) D RL1 G REXIT
I X'["-" S AMQQONE=1 D ^AMQQTXC S:Y>0 ^UTILITY("AMQQ TAX",$J,AMQQURGN,+Y)="" G REXIT
S X=$P(X,"-")
W !
D ^AMQQTXC
I 'AMQQA S AMQQTYP="HI",X=$P(AMQQSAVE("X"),"-",2) W ! D ^AMQQTXC
REXIT I 'AMQQA,'$D(AMQQQUIT),$D(@AMQQHILO) D RANGES^AMQQTXC
K AMQQSUB,AMQQTYP,AMQQDFN,DIR,AMQQSAVE,AMQQA,AMQQCNT,AMQQ,AMQQR,AMQQI,AMQQSTP,AMQQX,AMQQTXEX
Q
;
RL1 S AMQQSUB=1
S AMQQA=0
I X["-" S X=$P(X,"-") D ^AMQQTXC I 'AMQQA S X=$P(AMQQSAVE("X"),"-",2),AMQQTYP="HI" W ! D ^AMQQTXC Q
I X'["-" S AMQQTYP="LOW",AMQQONE=1 D ^AMQQTXC I Y>0 K ^UTILITY("AMQQ TAX",$J,AMQQURGN,+Y)
Q
;
RHELP1 ; ENTRY POINT ROM AMQQTXG
I '$D(@AMQQHILO) W !!,"A code range has yet to be selected. A display cannot be generated.",! Q
D SHOW^AMQQTXC
Q
;
AMQQTXG1 ; IHS/CMI/THL - LOOKUP FOR TAX ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
PLOOKUP ; ENTRY POINT FROM AMQQTXG
+1 SET DIC=AMQQTLOK
+2 SET DIC(0)="EQM"
+3 IF $GET(AMQQSQSN)=617
IF $GET(AMQQSQN)=620
SET %=$ORDER(^UTILITY("AMQQ TAX",$JOB,+$GET(AMQQTAX)-1,0))
IF '$ORDER(^(%))
SET DIC("S")="I $D(^BWDIAG(""P"","_%_",Y))"
+4 IF $DATA(AMQQNECO)
SET DIC(0)="M"
+5 IF DIC="^AUTTHF("
SET DIC("S")="I $P(^(0),U,10)=""F"""
+6 DO ^DIC
+7 KILL DIC,DUOUT,DTOUT
+8 IF Y'=-1
SET X=+Y
IF $DATA(AMQQTAXI)
IF $DATA(AMQQTDIC)
IF AMQQTAXI'=""
IF AMQQTDIC'=""
DO PLK1
+9 QUIT
+10 ;
PLK1 IF $GET(AMQQLINK)=32
SET X=$PIECE(Y,U,2)
+1 IF $DATA(AMQQTTX)
IF AMQQTTX'=""
IF $DATA(AMQQTAXT)
IF AMQQTAXT=5
XECUTE AMQQTTX
+2 SET %=AMQQTDIC_""""_AMQQTAXI_""",X)"
+3 IF '$DATA(AMQQNDB)
IF '$DATA(@%)
WRITE !," (none found in database so not selected... if you still want to select this",!," value enter it with quotes about it"
SET Y=-1
+4 KILL AMQQNDBC
+5 QUIT
+6 ;
PHELP ; ENTRY POINT FROM AMQQTXG
+1 WRITE !!,"Enter the name of a ",AMQQATNM,"."
+2 WRITE !,"Enter ""??"" to see your selections or ""???"" to see choices.",!!
+3 QUIT
+4 ;
PHELP1 ; ENTRY POINT FROM AMQQTXG
+1 SET DIC=AMQQTLOK
+2 SET DIC(0)="E"
+3 SET D="B"
+4 SET DZ="??"
+5 IF $GET(AMQQSQSN)=617
IF $GET(AMQQSQN)=620
SET %=$ORDER(^UTILITY("AMQQ TAX",$JOB,+$GET(AMQQTAX)-1,0))
IF '$ORDER(^(%))
SET DIC("S")="I $D(^BWDIAG(""P"","_%_",Y))"
+6 IF DIC="^AUTTHF("
SET DIC("S")="I $P(^(0),U,10)=""F"""
+7 DO DQ^DICQ
+8 KILL DIC,D,DZ
+9 QUIT
+10 ;
GLOOKUP ; ENTRY POINT FROM AMQQTXG
+1 SET Y=$FIND(AMQQSSET,(";"_X_":"))
+2 IF Y
SET Z=$EXTRACT(AMQQSSET,Y,256)
SET Z=$PIECE(Z,";")
WRITE " (",Z,")"
SET Y=X
QUIT
+3 SET Y=-1
+4 FOR %=2:1
SET Z=$PIECE(AMQQSSET,";",%)
IF Z=""
QUIT
IF $EXTRACT($PIECE(Z,":",2),1,$LENGTH(X))=X
WRITE $EXTRACT($PIECE(Z,":",2),$LENGTH(X)+1,99)
SET Y=$PIECE(Z,":")
QUIT
+5 IF Y=-1
WRITE *7," ??"
QUIT
+6 SET X=Y
+7 QUIT
+8 ;
GHELP1 ; ENTRY POINT FROM AMQQTXG
+1 SET %="You may select one or more of the following =>"
+2 WRITE !!,%,!
+3 FOR %=1:1
SET X=$PIECE(AMQQSSET,":",%)
WRITE !?5,$PIECE(X,";")
IF $PIECE(X,";",2)=""
QUIT
+4 QUIT
+5 ;
FHELP ; ENTRY POINT FROM AMQQTXG
+1 IF AMQQTAXI=""
WRITE !!,"Enter the name of a ",AMQQATN
QUIT
+2 SET %="You may select one or more of the following =>"
+3 WRITE !!,%,!
+4 SET %=""
+5 SET X=""
+6 SET T=AMQQTDIC_""""_AMQQTAXI_""")"
+7 FOR I=1:1
SET %=$ORDER(@T@(%))
IF %=""
QUIT
WRITE !
IF '(I#(IOSL-4))
DO FLIST1
WRITE ?5,%
IF X=U
QUIT
+8 QUIT
+9 ;
FLIST1 WRITE "<>"
+1 READ X:DTIME
WRITE *13,?5,*13
+2 QUIT
+3 ;
FLOOKUP ; ENTRY POINT FROM AMQQTXG
+1 IF AMQQTAXI=""
GOTO FEXIT
+2 SET T=AMQQTDIC_""""_AMQQTAXI_""")"
+3 IF '$DATA(@T@(X))
SET %=$ORDER(@T@(X))
IF $EXTRACT(%,1,$LENGTH(X))'=X
WRITE " <= Not found in data base",*7
GOTO FEXIT
+4 IF $DATA(@T@(X))
SET %=$ORDER(@T@(X))
IF $EXTRACT(%,1,$LENGTH(X))'=X
GOTO FEXIT
+5 IF '$DATA(@T@(X))
SET (%,Y)=$ORDER(@T@(X))
IF $EXTRACT(%,1,$LENGTH(X))=X
SET %=$ORDER(^(%))
IF $EXTRACT(%,1,$LENGTH(X))'=X
WRITE $EXTRACT(Y,$LENGTH(X)+1,99)
SET X=Y
GOTO FEXIT
+6 SET N=0
+7 SET Z=X
+8 IF $DATA(@T@(X))
SET ^UTILITY("AMQQ LOOK",$JOB,1)=X
SET N=1
FINCN SET Z=$ORDER(@T@(Z))
+1 IF $EXTRACT(Z,1,$LENGTH(X))'=X
SET N=N+1
DO FC1
IF Y'=0
GOTO FEXIT
GOTO FMORE
+2 SET N=N+1
+3 IF N>1
IF N#5=1
DO FC
IF Y=1
QUIT
IF Y=-1
GOTO FEXIT
IF Y=0
DO FEXIT
GOTO FLOOKUP
+4 WRITE !?5,N," ",Z
+5 SET ^UTILITY("AMQQ LOOK",$JOB,N)=Z
+6 GOTO FINCN
FMORE SET AMQQLMOR=""
FEXIT KILL T,^UTILITY("AMQQ LOOK",$JOB),N
+1 QUIT
+2 ;
FC WRITE !,"TYPE <CR> TO SEE MORE CHOICES, '^' TO STOP, OR"
FC1 WRITE !,"CHOOSE 1-",N-1,": "
+1 READ Y:DTIME
IF '$TEST
SET Y=U
+2 IF Y=""
QUIT
+3 IF Y=U
SET Y=-1
QUIT
+4 IF Y?1."?"
WRITE !,"Pick a number between 1 and ",N-1,". You can also enter a new name.",!
GOTO FC
+5 IF Y
IF $DATA(^UTILITY("AMQQ LOOK",$JOB,Y))
SET X=^(Y)
WRITE " (",X,")"
QUIT
+6 IF Y=+Y
WRITE " ??",*7
GOTO FC1
+7 SET X=Y
+8 SET Y=0
+9 QUIT
+10 ;
RHELP ; ENTRY POINT FROM AMQQTXG
+1 SET X="DIAG"
+2 IF AMQQLINK=31
SET Z="diagnosis^diagnoses^ICD9^250.00^250.51^CAUSE or LOCATION"
+3 IF AMQQLINK=174
SET Z="procedure^procedures^ADA^AAA^BBB^CCC"
+4 IF AMQQLINK=455
SET Z="CPT CODE^CPT CODES^CPT^11040^11044"
+5 DO ^AMQQHEL1
+6 QUIT
+7 ;
RLOOKUP ; ENTRY POINT FROM AMQQTXG
+1 SET AMQQSAVE("X")=X
+2 SET (AMQQONE,AMQQSUB,AMQQA)=0
+3 SET AMQQ("NO DISPLAY")=0
+4 SET AMQQ("NOT TAX")=""
+5 SET AMQQTYP="LOW"
+6 IF $DATA(AMQQTXEX)
DO RL1
GOTO REXIT
+7 IF X'["-"
SET AMQQONE=1
DO ^AMQQTXC
IF Y>0
SET ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,+Y)=""
GOTO REXIT
+8 SET X=$PIECE(X,"-")
+9 WRITE !
+10 DO ^AMQQTXC
+11 IF 'AMQQA
SET AMQQTYP="HI"
SET X=$PIECE(AMQQSAVE("X"),"-",2)
WRITE !
DO ^AMQQTXC
REXIT IF 'AMQQA
IF '$DATA(AMQQQUIT)
IF $DATA(@AMQQHILO)
DO RANGES^AMQQTXC
+1 KILL AMQQSUB,AMQQTYP,AMQQDFN,DIR,AMQQSAVE,AMQQA,AMQQCNT,AMQQ,AMQQR,AMQQI,AMQQSTP,AMQQX,AMQQTXEX
+2 QUIT
+3 ;
RL1 SET AMQQSUB=1
+1 SET AMQQA=0
+2 IF X["-"
SET X=$PIECE(X,"-")
DO ^AMQQTXC
IF 'AMQQA
SET X=$PIECE(AMQQSAVE("X"),"-",2)
SET AMQQTYP="HI"
WRITE !
DO ^AMQQTXC
QUIT
+3 IF X'["-"
SET AMQQTYP="LOW"
SET AMQQONE=1
DO ^AMQQTXC
IF Y>0
KILL ^UTILITY("AMQQ TAX",$JOB,AMQQURGN,+Y)
+4 QUIT
+5 ;
RHELP1 ; ENTRY POINT ROM AMQQTXG
+1 IF '$DATA(@AMQQHILO)
WRITE !!,"A code range has yet to be selected. A display cannot be generated.",!
QUIT
+2 DO SHOW^AMQQTXC
+3 QUIT
+4 ;
