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