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