AMQQMULP ; IHS/CMI/THL - PROVIDER CRITERIA ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
VAR S %=AMQQX
S AMQQSQPS=+%
S AMQQSQP1=$P(%,";",2)
S AMQQSQP2=$P(%,";",3)
S AMQQSQPZ=$P(%,";",4)
S AMQQSQPG="^UTILITY(""AMQQ"",$J,""PRO"")"
K @AMQQSQPG
RUN K AMQP(5)
I '$G(AMQP(1)) S AMQT(AMQQSQPZ)=0 G EXIT
N X,A,B,C
I '$D(^AUPNVPRV("AD",AMQP(1))) D I 1
.I '$D(AMQQGR) Q
.I $G(AMQQGR)'["VMED",$G(AMQQGR)'["VLAB" D I 1
..S A=0
..S B="^"_AMQQGR
..F Q:$D(X) S A=$O(@B@("AD",AMQP(1),A)) Q:'A I +@B@(A,0)=AMQQVALU S X=$P(^(0),U,$S(B["VMED":9,1:7))
.E S X=$S(AMQQGR["VMED":$P($G(^AUPNVMED(+$G(AMQP(.11)),0)),U,9),1:$P($G(^AUPNVLAB(+$G(AMQP(.2)),0)),U,7))
.I $G(X)]"" S @AMQQSQPG@(X)="",AMQP(5)=X
E F AMQQSQPD=0:0 S AMQQSQPD=$O(^AUPNVPRV("AD",AMQP(1),AMQQSQPD)) Q:'AMQQSQPD S X=^AUPNVPRV(AMQQSQPD,0) D PASS1
I $D(@AMQQSQPG) D PASS2
CK S AMQT(AMQQSQPZ)=$D(@AMQQSQPG)
I AMQT(AMQQSQPZ),'$D(AMQP(5)) D PRIME
EXIT K @AMQQSQPG,AMQQSQPS,AMQQSQP1,AMQQSQP2,AMQQSQPT,AMQQSQPN,AMQQSQPG,AMQQSQPZ,AMQQSQPD
Q
;
PASS1 I AMQQSQPS=3 G SET1
S Y=$P(X,U,4)
I AMQQSQPS=1,Y'="P" Q
I AMQQSQPS=2,Y'="S" Q
SET1 S @AMQQSQPG@(+X)=""
Q
;
PASS2 N AMQP
S AMQQSQPN=AMQQSQP1-.001
F S AMQQSQPN=$O(AMQV("QQ",AMQQSQPN)) Q:'AMQQSQPN Q:AMQQSQPN>AMQQSQP2 S AMQQSQPT=AMQV("QQ",AMQQSQPN,1) D TEST
Q
;
TEST F AMQP(5)=0:0 S AMQP(5)=$O(^UTILITY("AMQQ",$J,"PRO",AMQP(5))) Q:'AMQP(5) X AMQQSQPT I K ^UTILITY("AMQQ",$J,"PRO",AMQP(5))
Q
;
POV ; ENTRY POINT FROM METADICTIONARY
N X,Y,Z,%,A
S X=+AMQQX
S Y=$P(AMQQX,";",4)
S Z=0
S A=$P(AMQQX,";",5)
I $D(^UTILITY("AMQQ TAX",$J,X,"--")) D POV1 Q
I $D(^UTILITY("AMQQ TAX",$J,X,"-")) S AMQT(Y)='$D(^AUPNVPOV("AD",AMQP(1))),AMQP(A)="-" Q
F S Z=$O(^AUPNVPOV("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVPOV(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%))+$D(^("*")) S AMQP(A)="+" G POVEXIT
S AMQT(Y)=0
Q
POVEXIT S AMQT(Y)=1
Q
;
POV1 F S Z=$O(^AUPNVPOV("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVPOV(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%)) G POVEXIT1
S AMQT(Y)=1
S AMQP(A)="-"
Q
POVEXIT1 S AMQT(Y)=0
Q
;
PRIME N %,X
S AMQP(5)="??"
F %=0:0 S %=$O(^AUPNVPRV("AD",AMQP(1),%)) Q:'% S X=$G(^AUPNVPRV(%,0)) I $P(X,U,4)="P" S AMQP(5)=+X Q
Q
;
PRC ; ENTRY POINT FROM METADICTIONARY
N X,Y,Z,%,A
S X=+AMQQX
S Y=$P(AMQQX,";",4)
S Z=0
S A=$P(AMQQX,";",5)
I $D(^UTILITY("AMQQ TAX",$J,X,"--")) D PRC1 Q
I $D(^UTILITY("AMQQ TAX",$J,X,"-")) S AMQT(Y)='$D(^AUPNVPRC("AD",AMQP(1))),AMQP(A)="-" Q
F S Z=$O(^AUPNVPRC("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVPRC(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%))+$D(^("*")) S AMQP(A)="+" G PRCEXIT
S AMQT(Y)=0
Q
PRCEXIT S AMQT(Y)=1
Q
;
PRC1 F S Z=$O(^AUPNVPRC("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVPRC(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%)) G PRCEXIT1
S AMQT(Y)=1
S AMQP(A)="-"
Q
PRCEXIT1 S AMQT(Y)=0
Q
;
DXP ; ENTRY POINT FROM METADICTIONARY FOR V DIAGNOSTIC PROCEDURE RESULTS
N X,Y,Z,%,A
S X=+AMQQX
S Y=$P(AMQQX,";",4)
S Z=0
S A=$P(AMQQX,";",5)
I $D(^UTILITY("AMQQ TAX",$J,X,"--")) D DXP1 Q
I $D(^UTILITY("AMQQ TAX",$J,X,"-")) S AMQT(Y)='$D(^AUPNVDXP("AD",AMQP(1))),AMQP(A)="-" Q
F S Z=$O(^AUPNVDXP("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVDXP(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%))+$D(^("*")) S AMQP(A)="+" G DXPEXIT
S AMQT(Y)=0
Q
DXPEXIT ;
S AMQT(Y)=1
Q
;
DXP1 ;
F S Z=$O(^AUPNVDXP("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVDXP(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%)) G DXPEXIT1
S AMQT(Y)=1
S AMQP(A)="-"
Q
DXPEXIT1 ;
S AMQT(Y)=0
Q
;
CPT ;EP METADICTIONARY;
N X,Y,Z,%,A
S X=+AMQQX
S Y=$P(AMQQX,";",4)
S Z=0
S A=$P(AMQQX,";",5)
I $D(^UTILITY("AMQQ TAX",$J,X,"--")) D CPT1 Q
I $D(^UTILITY("AMQQ TAX",$J,X,"-")) S AMQT(Y)='$D(^AUPNVCPT("AD",AMQP(1))),AMQP(A)="-" Q
F S Z=$O(^AUPNVCPT("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVCPT(Z,0)),U) I %,$D(^UTILITY("AMQQ TAX",$J,X,%))+$D(^("*")) S AMQP(A)="+" G POVEXIT
S AMQT(Y)=0
Q
;
CPTEXIT ;
S AMQT(Y)=1
Q
;
CPT1 ;
F S Z=$O(^AUPNVCPT("AD",AMQP(1),Z)) Q:'Z S %=$P($G(^AUPNVCPT(Z,0)),U) I %,$D(UTILITY("AMQQ TAX",$J,X,%)) G CPTEXIT1
S AMQT(Y)=1
S AMQP(A)="-"
Q
;
CPTEXIT1 ;
S AMQT(Y)=0
Q
;
AMQQMULP ; IHS/CMI/THL - PROVIDER CRITERIA ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
VAR SET %=AMQQX
+1 SET AMQQSQPS=+%
+2 SET AMQQSQP1=$PIECE(%,";",2)
+3 SET AMQQSQP2=$PIECE(%,";",3)
+4 SET AMQQSQPZ=$PIECE(%,";",4)
+5 SET AMQQSQPG="^UTILITY(""AMQQ"",$J,""PRO"")"
+6 KILL @AMQQSQPG
RUN KILL AMQP(5)
+1 IF '$GET(AMQP(1))
SET AMQT(AMQQSQPZ)=0
GOTO EXIT
+2 NEW X,A,B,C
+3 IF '$DATA(^AUPNVPRV("AD",AMQP(1)))
Begin DoDot:1
+4 IF '$DATA(AMQQGR)
QUIT
+5 IF $GET(AMQQGR)'["VMED"
IF $GET(AMQQGR)'["VLAB"
Begin DoDot:2
+6 SET A=0
+7 SET B="^"_AMQQGR
+8 FOR
IF $DATA(X)
QUIT
SET A=$ORDER(@B@("AD",AMQP(1),A))
IF 'A
QUIT
IF +@B@(A,0)=AMQQVALU
SET X=$PIECE(^(0),U,$SELECT(B["VMED":9,1:7))
End DoDot:2
IF 1
+9 IF '$TEST
SET X=$SELECT(AMQQGR["VMED":$PIECE($GET(^AUPNVMED(+$GET(AMQP(.11)),0)),U,9),1:$PIECE($GET(^AUPNVLAB(+$GET(AMQP(.2)),0)),U,7))
+10 IF $GET(X)]""
SET @AMQQSQPG@(X)=""
SET AMQP(5)=X
End DoDot:1
IF 1
+11 IF '$TEST
FOR AMQQSQPD=0:0
SET AMQQSQPD=$ORDER(^AUPNVPRV("AD",AMQP(1),AMQQSQPD))
IF 'AMQQSQPD
QUIT
SET X=^AUPNVPRV(AMQQSQPD,0)
DO PASS1
+12 IF $DATA(@AMQQSQPG)
DO PASS2
CK SET AMQT(AMQQSQPZ)=$DATA(@AMQQSQPG)
+1 IF AMQT(AMQQSQPZ)
IF '$DATA(AMQP(5))
DO PRIME
EXIT KILL @AMQQSQPG,AMQQSQPS,AMQQSQP1,AMQQSQP2,AMQQSQPT,AMQQSQPN,AMQQSQPG,AMQQSQPZ,AMQQSQPD
+1 QUIT
+2 ;
PASS1 IF AMQQSQPS=3
GOTO SET1
+1 SET Y=$PIECE(X,U,4)
+2 IF AMQQSQPS=1
IF Y'="P"
QUIT
+3 IF AMQQSQPS=2
IF Y'="S"
QUIT
SET1 SET @AMQQSQPG@(+X)=""
+1 QUIT
+2 ;
PASS2 NEW AMQP
+1 SET AMQQSQPN=AMQQSQP1-.001
+2 FOR
SET AMQQSQPN=$ORDER(AMQV("QQ",AMQQSQPN))
IF 'AMQQSQPN
QUIT
IF AMQQSQPN>AMQQSQP2
QUIT
SET AMQQSQPT=AMQV("QQ",AMQQSQPN,1)
DO TEST
+3 QUIT
+4 ;
TEST FOR AMQP(5)=0:0
SET AMQP(5)=$ORDER(^UTILITY("AMQQ",$JOB,"PRO",AMQP(5)))
IF 'AMQP(5)
QUIT
XECUTE AMQQSQPT
IF $TEST
KILL ^UTILITY("AMQQ",$JOB,"PRO",AMQP(5))
+1 QUIT
+2 ;
POV ; ENTRY POINT FROM METADICTIONARY
+1 NEW X,Y,Z,%,A
+2 SET X=+AMQQX
+3 SET Y=$PIECE(AMQQX,";",4)
+4 SET Z=0
+5 SET A=$PIECE(AMQQX,";",5)
+6 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"--"))
DO POV1
QUIT
+7 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"-"))
SET AMQT(Y)='$DATA(^AUPNVPOV("AD",AMQP(1)))
SET AMQP(A)="-"
QUIT
+8 FOR
SET Z=$ORDER(^AUPNVPOV("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVPOV(Z,0)),U)
IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,%))+$DATA(^("*"))
SET AMQP(A)="+"
GOTO POVEXIT
+9 SET AMQT(Y)=0
+10 QUIT
POVEXIT SET AMQT(Y)=1
+1 QUIT
+2 ;
POV1 FOR
SET Z=$ORDER(^AUPNVPOV("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVPOV(Z,0)),U)
IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,%))
GOTO POVEXIT1
+1 SET AMQT(Y)=1
+2 SET AMQP(A)="-"
+3 QUIT
POVEXIT1 SET AMQT(Y)=0
+1 QUIT
+2 ;
PRIME NEW %,X
+1 SET AMQP(5)="??"
+2 FOR %=0:0
SET %=$ORDER(^AUPNVPRV("AD",AMQP(1),%))
IF '%
QUIT
SET X=$GET(^AUPNVPRV(%,0))
IF $PIECE(X,U,4)="P"
SET AMQP(5)=+X
QUIT
+3 QUIT
+4 ;
PRC ; ENTRY POINT FROM METADICTIONARY
+1 NEW X,Y,Z,%,A
+2 SET X=+AMQQX
+3 SET Y=$PIECE(AMQQX,";",4)
+4 SET Z=0
+5 SET A=$PIECE(AMQQX,";",5)
+6 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"--"))
DO PRC1
QUIT
+7 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"-"))
SET AMQT(Y)='$DATA(^AUPNVPRC("AD",AMQP(1)))
SET AMQP(A)="-"
QUIT
+8 FOR
SET Z=$ORDER(^AUPNVPRC("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVPRC(Z,0)),U)
IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,%))+$DATA(^("*"))
SET AMQP(A)="+"
GOTO PRCEXIT
+9 SET AMQT(Y)=0
+10 QUIT
PRCEXIT SET AMQT(Y)=1
+1 QUIT
+2 ;
PRC1 FOR
SET Z=$ORDER(^AUPNVPRC("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVPRC(Z,0)),U)
IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,%))
GOTO PRCEXIT1
+1 SET AMQT(Y)=1
+2 SET AMQP(A)="-"
+3 QUIT
PRCEXIT1 SET AMQT(Y)=0
+1 QUIT
+2 ;
DXP ; ENTRY POINT FROM METADICTIONARY FOR V DIAGNOSTIC PROCEDURE RESULTS
+1 NEW X,Y,Z,%,A
+2 SET X=+AMQQX
+3 SET Y=$PIECE(AMQQX,";",4)
+4 SET Z=0
+5 SET A=$PIECE(AMQQX,";",5)
+6 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"--"))
DO DXP1
QUIT
+7 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"-"))
SET AMQT(Y)='$DATA(^AUPNVDXP("AD",AMQP(1)))
SET AMQP(A)="-"
QUIT
+8 FOR
SET Z=$ORDER(^AUPNVDXP("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVDXP(Z,0)),U)
IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,%))+$DATA(^("*"))
SET AMQP(A)="+"
GOTO DXPEXIT
+9 SET AMQT(Y)=0
+10 QUIT
DXPEXIT ;
+1 SET AMQT(Y)=1
+2 QUIT
+3 ;
DXP1 ;
+1 FOR
SET Z=$ORDER(^AUPNVDXP("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVDXP(Z,0)),U)
IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,%))
GOTO DXPEXIT1
+2 SET AMQT(Y)=1
+3 SET AMQP(A)="-"
+4 QUIT
DXPEXIT1 ;
+1 SET AMQT(Y)=0
+2 QUIT
+3 ;
CPT ;EP METADICTIONARY;
+1 NEW X,Y,Z,%,A
+2 SET X=+AMQQX
+3 SET Y=$PIECE(AMQQX,";",4)
+4 SET Z=0
+5 SET A=$PIECE(AMQQX,";",5)
+6 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"--"))
DO CPT1
QUIT
+7 IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,"-"))
SET AMQT(Y)='$DATA(^AUPNVCPT("AD",AMQP(1)))
SET AMQP(A)="-"
QUIT
+8 FOR
SET Z=$ORDER(^AUPNVCPT("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVCPT(Z,0)),U)
IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,X,%))+$DATA(^("*"))
SET AMQP(A)="+"
GOTO POVEXIT
+9 SET AMQT(Y)=0
+10 QUIT
+11 ;
CPTEXIT ;
+1 SET AMQT(Y)=1
+2 QUIT
+3 ;
CPT1 ;
+1 FOR
SET Z=$ORDER(^AUPNVCPT("AD",AMQP(1),Z))
IF 'Z
QUIT
SET %=$PIECE($GET(^AUPNVCPT(Z,0)),U)
IF %
IF $DATA(UTILITY("AMQQ TAX",$JOB,X,%))
GOTO CPTEXIT1
+2 SET AMQT(Y)=1
+3 SET AMQP(A)="-"
+4 QUIT
+5 ;
CPTEXIT1 ;
+1 SET AMQT(Y)=0
+2 QUIT
+3 ;
