AMQQMULR ; IHS/CMI/THL - COLLECTS MULTIPLE VALUES FOR REFUSAL TYPES ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
VAR F I=1:1:19 D
.S X=$P("GR;ID;ST;FIN;LAST;VAL1;SPEC;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I)
.S @("AMQQ"_X)=$P(AMQQX,";",I)
I '$D(AMQQAG) S AMQQAG="AG"
S AMQQVAL1=+AMQQVAL1
S AMQQMPC=1
S AMQQMSS=0
S AMQQ=U_AMQQGR_"(""AC"",AMQP(0))"
S AMQQHOLD=0
S AMQT(AMQQT)=0
S AMQQLCNT=0
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
I $E(AMQQST)?1P,'$D(AMQQSQVN) D REL^AMQQMULS
I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
I '$D(AMQQSQVN),'$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
I $G(AMQQSPEC)="EXISTS",AMQQSTRT=2,'AMQQST,'AMQQUSQN,AMQQFIN=9999999,AMQQLAST=9999999 S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="+",AMQP(AMQQFVAR)="+",AMQT(AMQQT)=1 G EXIT
RUN S AMQQVNO=0
D INC
SQ I $D(AMQV("SQ")) D ^AMQQMULS
I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL"!(AMQQSPEC="INVERSE") K ^(AMQQUATN) G EXIT
I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC'="NULL",AMQQSPEC'="ANY",AMQQSPEC'="INVERSE"
E S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
D EXIT3^AMQQKILL
Q
;
INC S AMQQDA=$G(AMQP(4))
I 'AMQQDA,$G(AMQP(0)) D PAT Q
I 'AMQQDA,'$G(AMQP(0)) D ALL Q
INC1 S %=$G(^AUPNPREF(AMQQDA,0))
N AMQQVALU,AMQQDATE,AMQQREAS
S AMQQVALU=$P(%,U)
S AMQP(0)=$P(%,U,2)
S AMQQDATE=$P(%,U,3)
S AMQQREAS=$P(%,U,4)
S AMQQPT=$P(%,U,6)
D SET
I AMQQLCNT=AMQQLAST D LASTEVAL^AMQQMULT I $D(AMQQQUIT) K AMQQQUIT Q
I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1 Q
Q
;
SET I AMQQVALU="" Q
I $D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,AMQQVALU,"REFUSAL")),'$D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,AMQQVALU,"REFUSAL",+AMQQPT)) Q
I '$D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,AMQQVALU)),'$D(^("*")),'$D(^("-")) Q
S1 S AMQQHOLD=AMQQHOLD+1
S AMQQLCNT=AMQQLCNT+1
S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_AMQQDATE_U_AMQQREAS_U_AMQQDA
K AMQQOK
Q
;
ALL ;PROCESS ALL TYPES OF REFUSALS
N REF,REFDA
S REF=""
F S REF=$O(^AUTTREFT("B",REF)) Q:REF="" D
.S REFDA=0
.F S REFDA=$O(^AUTTREFT("B",REF,REFDA)) Q:'REFDA D
..S AMQQDA=0
..F S AMQQDA=$O(^AUPNPREF("B",REFDA,AMQQDA)) Q:'AMQQDA D
...D INC1:'$D(^UTILITY("AMQQ REFUSAL",$J,AMQQDA))
...S ^UTILITY("AMQQ REFUSAL",$J,AMQQDA)=""
S AMQP(.1)=99999999999
Q
PAT ;PROCESS REFUSALS FOR A PATIENT
N REF,REFDA
S REFDA=0
F S AMQQDA=$O(^AUPNPREF("AC",AMQP(0),AMQQDA)) Q:'AMQQDA D
.D INC1
Q
AMQQMULR ; IHS/CMI/THL - COLLECTS MULTIPLE VALUES FOR REFUSAL TYPES ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
VAR FOR I=1:1:19
Begin DoDot:1
+1 SET X=$PIECE("GR;ID;ST;FIN;LAST;VAL1;SPEC;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I)
+2 SET @("AMQQ"_X)=$PIECE(AMQQX,";",I)
End DoDot:1
+3 IF '$DATA(AMQQAG)
SET AMQQAG="AG"
+4 SET AMQQVAL1=+AMQQVAL1
+5 SET AMQQMPC=1
+6 SET AMQQMSS=0
+7 SET AMQQ=U_AMQQGR_"(""AC"",AMQP(0))"
+8 SET AMQQHOLD=0
+9 SET AMQT(AMQQT)=0
+10 SET AMQQLCNT=0
+11 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+12 IF $EXTRACT(AMQQST)?1P
IF '$DATA(AMQQSQVN)
DO REL^AMQQMULS
+13 IF AMQQMULZ
SET AMQQMUNV=AMQQNVAR
SET AMQQMUFV=AMQQFVAR
SET AMQQMULL=AMQQMULZ
+14 IF '$DATA(AMQQSQVN)
IF '$DATA(@AMQQ)
SET AMQT(AMQQT)=0
GOTO NULL
+15 IF $GET(AMQQSPEC)="EXISTS"
IF AMQQSTRT=2
IF 'AMQQST
IF 'AMQQUSQN
IF AMQQFIN=9999999
IF AMQQLAST=9999999
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)="+"
SET AMQP(AMQQFVAR)="+"
SET AMQT(AMQQT)=1
GOTO EXIT
RUN SET AMQQVNO=0
+1 DO INC
SQ IF $DATA(AMQV("SQ"))
DO ^AMQQMULS
+1 IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
IF AMQQSPEC="NULL"!(AMQQSPEC="INVERSE")
KILL ^(AMQQUATN)
GOTO EXIT
+2 IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
GOTO TRUE
NULL IF AMQQSPEC'="NULL"
IF AMQQSPEC'="ANY"
IF AMQQSPEC'="INVERSE"
+1 IF '$TEST
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)="-"
SET AMQP(AMQQFVAR)="-"
SET AMQT(AMQQT)=1
+2 GOTO EXIT
TRUE IF AMQQSPEC="EXISTS"
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
SET ^(AMQQUATN,1)="+"
SET AMQP(AMQQFVAR)="+"
+1 SET AMQT(AMQQT)=1
EXIT IF AMQQAG="SAG"
KILL ^UTILITY("AMQQ",$JOB,"SAG",AMQQUATN)
+1 DO EXIT3^AMQQKILL
+2 QUIT
+3 ;
INC SET AMQQDA=$GET(AMQP(4))
+1 IF 'AMQQDA
IF $GET(AMQP(0))
DO PAT
QUIT
+2 IF 'AMQQDA
IF '$GET(AMQP(0))
DO ALL
QUIT
INC1 SET %=$GET(^AUPNPREF(AMQQDA,0))
+1 NEW AMQQVALU,AMQQDATE,AMQQREAS
+2 SET AMQQVALU=$PIECE(%,U)
+3 SET AMQP(0)=$PIECE(%,U,2)
+4 SET AMQQDATE=$PIECE(%,U,3)
+5 SET AMQQREAS=$PIECE(%,U,4)
+6 SET AMQQPT=$PIECE(%,U,6)
+7 DO SET
+8 IF AMQQLCNT=AMQQLAST
DO LASTEVAL^AMQQMULT
IF $DATA(AMQQQUIT)
KILL AMQQQUIT
QUIT
+9 IF AMQQSPEC="EXISTS"!(AMQQSPEC="NULL")
IF AMQQLCNT
IF '$DATA(AMQV("SQ"))
SET AMQQLCNT=-1
QUIT
+10 QUIT
+11 ;
SET IF AMQQVALU=""
QUIT
+1 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQVAL1,AMQQVALU,"REFUSAL"))
IF '$DATA(^UTILITY("AMQQ TAX",$JOB,AMQQVAL1,AMQQVALU,"REFUSAL",+AMQQPT))
QUIT
+2 IF '$DATA(^UTILITY("AMQQ TAX",$JOB,AMQQVAL1,AMQQVALU))
IF '$DATA(^("*"))
IF '$DATA(^("-"))
QUIT
S1 SET AMQQHOLD=AMQQHOLD+1
+1 SET AMQQLCNT=AMQQLCNT+1
+2 SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_AMQQDATE_U_AMQQREAS_U_AMQQDA
+3 KILL AMQQOK
+4 QUIT
+5 ;
ALL ;PROCESS ALL TYPES OF REFUSALS
+1 NEW REF,REFDA
+2 SET REF=""
+3 FOR
SET REF=$ORDER(^AUTTREFT("B",REF))
IF REF=""
QUIT
Begin DoDot:1
+4 SET REFDA=0
+5 FOR
SET REFDA=$ORDER(^AUTTREFT("B",REF,REFDA))
IF 'REFDA
QUIT
Begin DoDot:2
+6 SET AMQQDA=0
+7 FOR
SET AMQQDA=$ORDER(^AUPNPREF("B",REFDA,AMQQDA))
IF 'AMQQDA
QUIT
Begin DoDot:3
+8 IF '$DATA(^UTILITY("AMQQ REFUSAL",$JOB,AMQQDA))
DO INC1
+9 SET ^UTILITY("AMQQ REFUSAL",$JOB,AMQQDA)=""
End DoDot:3
End DoDot:2
End DoDot:1
+10 SET AMQP(.1)=99999999999
+11 QUIT
PAT ;PROCESS REFUSALS FOR A PATIENT
+1 NEW REF,REFDA
+2 SET REFDA=0
+3 FOR
SET AMQQDA=$ORDER(^AUPNPREF("AC",AMQP(0),AMQQDA))
IF 'AMQQDA
QUIT
Begin DoDot:1
+4 DO INC1
End DoDot:1
+5 QUIT
