- 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
