AMQQMUL2 ; IHS/CMI/THL - COLLECTS MULTIPLE VALUES FOR VISITS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
VAR F I=1:1:19 D
.S X=$P("GR;ID;ST;FIN;LAST;VAL1;VAL2;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I)
.S @("AMQQ"_X)=$P(AMQQX,";",I)
S AMQQ=U_AMQQGR_"(""AA"","_AMQP(0)_")"
S AMQQSPEC=""
I '$D(AMQQAG) S AMQQAG="AG"
I '$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
S AMQQMSS=+AMQQMSS
S AMQQMPC=AMQQMPC+'AMQQMPC
S AMQQHOLD=0
S AMQT(AMQQT)=0
S AMQQLCNT=0
S AMQQSPEC=""
I AMQQVAL1["~~" S AMQQSPEC=AMQQVAL2,AMQQVAL2=$P(AMQQVAL1,"~~",2),AMQQVAL1=$P(AMQQVAL1,"~~")
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
I $E(AMQQST)?1P,'$D(AMQQSQVN) D REL^AMQQMULS
I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
RUN D INC
SQ I $D(AMQV("SQ")) D ^AMQQMULS
I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL" K ^(AMQQUATN) G EXIT
I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)) S AMQP(AMQQFVAR)=$P(^(1),U)
I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC="NULL"!(AMQQSPEC="ANY") 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 I AMQQ["AUPNVSIT" S AMQQVDAT=9999999-$P(AMQQFIN,".")
E S AMQQVDAT=9999999-AMQQFIN
INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQVDAT))
I AMQQVDAT'=+AMQQVDAT Q
I AMQQ["AUPNVSIT" Q:(9999999-$P(AMQQVDAT,"."))<$P(AMQQST,".") G:$P(AMQQVDAT,".",2)']$P(AMQQST,".",2)&((9999999-$P(AMQQVDAT,"."))=$P(AMQQST,".")) INCDATE
E I (9999999-AMQQVDAT)'>AMQQST Q
S AMQQVSIT=0
INCITEM S (AMQQVNO,AMQQVSIT)=$O(@AMQQ@(AMQQVDAT,AMQQVSIT))
I 'AMQQVSIT G INCDATE
I $P($G(^AUPNVSIT(AMQQVSIT,0)),U,11) G INCITEM
I 'AMQQMSS,AMQQMPC=1 S AMQQVALU=(9999999-$P(AMQQVDAT,".")) D S1 G CNT
S %=U_AMQQGR_"("_AMQQVSIT_","_AMQQMSS_")"
I $D(@%) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC) D SET I 1
E G INCITEM
CNT 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
G INCITEM
;
SET I AMQQVALU="",$L(AMQQVAL1)>1,AMQQNNA'=5 Q
I AMQQITR'="" S X=AMQQVALU X AMQQITR S AMQQVALU=X
I $D(AMQQNNA),AMQQNNA>1 X "I 0" D ^AMQQMULN D:$T S1 Q
I AMQQVAL2'=+AMQQVAL2 D TEXT^AMQQFAN D:$T S1 Q
S AMQQVALU=+AMQQVALU
I AMQQVAL1>AMQQVAL2,AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1) D S1 Q
I AMQQVALU=AMQQVAL1,AMQQVALU=AMQQVAL2 D S1 Q
I AMQQVALU>AMQQVAL1,AMQQVALU<AMQQVAL2 D S1
Q
;
S1 S AMQQLCNT=AMQQLCNT+1
S AMQQHOLD=AMQQHOLD+1
S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-$P(AMQQVDAT,"."))_U_AMQQVSIT_U_AMQQVNO
Q
;
LASTEVAL ;EVALUATE 'LAST' CONDITION
K AMQQQUIT
S AMQP(1)=AMQQVSIT
X AMQV("QQ",1,1)
I '$G(AMQT(1)) S AMQQLAST=AMQQLAST+1 Q
S AMQQQUIT=""
Q
AMQQMUL2 ; IHS/CMI/THL - COLLECTS MULTIPLE VALUES FOR VISITS ;
+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;VAL2;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I)
+2 SET @("AMQQ"_X)=$PIECE(AMQQX,";",I)
End DoDot:1
+3 SET AMQQ=U_AMQQGR_"(""AA"","_AMQP(0)_")"
+4 SET AMQQSPEC=""
+5 IF '$DATA(AMQQAG)
SET AMQQAG="AG"
+6 IF '$DATA(@AMQQ)
SET AMQT(AMQQT)=0
GOTO NULL
+7 SET AMQQMSS=+AMQQMSS
+8 SET AMQQMPC=AMQQMPC+'AMQQMPC
+9 SET AMQQHOLD=0
+10 SET AMQT(AMQQT)=0
+11 SET AMQQLCNT=0
+12 SET AMQQSPEC=""
+13 IF AMQQVAL1["~~"
SET AMQQSPEC=AMQQVAL2
SET AMQQVAL2=$PIECE(AMQQVAL1,"~~",2)
SET AMQQVAL1=$PIECE(AMQQVAL1,"~~")
+14 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+15 IF $EXTRACT(AMQQST)?1P
IF '$DATA(AMQQSQVN)
DO REL^AMQQMULS
+16 IF AMQQMULZ
SET AMQQMUNV=AMQQNVAR
SET AMQQMUFV=AMQQFVAR
SET AMQQMULL=AMQQMULZ
RUN DO INC
SQ IF $DATA(AMQV("SQ"))
DO ^AMQQMULS
+1 IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
IF AMQQSPEC="NULL"
KILL ^(AMQQUATN)
GOTO EXIT
+2 IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1))
SET AMQP(AMQQFVAR)=$PIECE(^(1),U)
+3 IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
GOTO TRUE
NULL IF AMQQSPEC="NULL"!(AMQQSPEC="ANY")
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)="-"
SET AMQP(AMQQFVAR)="-"
SET AMQT(AMQQT)=1
+1 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 IF AMQQ["AUPNVSIT"
SET AMQQVDAT=9999999-$PIECE(AMQQFIN,".")
+1 IF '$TEST
SET AMQQVDAT=9999999-AMQQFIN
INCDATE SET AMQQVDAT=$ORDER(@AMQQ@(AMQQVDAT))
+1 IF AMQQVDAT'=+AMQQVDAT
QUIT
+2 IF AMQQ["AUPNVSIT"
IF (9999999-$PIECE(AMQQVDAT,"."))<$PIECE(AMQQST,".")
QUIT
IF $PIECE(AMQQVDAT,".",2)']$PIECE(AMQQST,".",2)&((9999999-$PIECE(AMQQVDAT,"."))=$PIECE(AMQQST,"."))
GOTO INCDATE
+3 IF '$TEST
IF (9999999-AMQQVDAT)'>AMQQST
QUIT
+4 SET AMQQVSIT=0
INCITEM SET (AMQQVNO,AMQQVSIT)=$ORDER(@AMQQ@(AMQQVDAT,AMQQVSIT))
+1 IF 'AMQQVSIT
GOTO INCDATE
+2 IF $PIECE($GET(^AUPNVSIT(AMQQVSIT,0)),U,11)
GOTO INCITEM
+3 IF 'AMQQMSS
IF AMQQMPC=1
SET AMQQVALU=(9999999-$PIECE(AMQQVDAT,"."))
DO S1
GOTO CNT
+4 SET %=U_AMQQGR_"("_AMQQVSIT_","_AMQQMSS_")"
+5 IF $DATA(@%)
SET AMQQVALU=$PIECE(^(AMQQMSS),U,AMQQMPC)
DO SET
IF 1
+6 IF '$TEST
GOTO INCITEM
CNT IF AMQQLCNT=AMQQLAST
DO LASTEVAL^AMQQMULT
IF $DATA(AMQQQUIT)
KILL AMQQQUIT
QUIT
+1 IF AMQQSPEC="EXISTS"!(AMQQSPEC="NULL")
IF AMQQLCNT
IF '$DATA(AMQV("SQ"))
SET AMQQLCNT=-1
QUIT
+2 GOTO INCITEM
+3 ;
SET IF AMQQVALU=""
IF $LENGTH(AMQQVAL1)>1
IF AMQQNNA'=5
QUIT
+1 IF AMQQITR'=""
SET X=AMQQVALU
XECUTE AMQQITR
SET AMQQVALU=X
+2 IF $DATA(AMQQNNA)
IF AMQQNNA>1
XECUTE "I 0"
DO ^AMQQMULN
IF $TEST
DO S1
QUIT
+3 IF AMQQVAL2'=+AMQQVAL2
DO TEXT^AMQQFAN
IF $TEST
DO S1
QUIT
+4 SET AMQQVALU=+AMQQVALU
+5 IF AMQQVAL1>AMQQVAL2
IF AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1)
DO S1
QUIT
+6 IF AMQQVALU=AMQQVAL1
IF AMQQVALU=AMQQVAL2
DO S1
QUIT
+7 IF AMQQVALU>AMQQVAL1
IF AMQQVALU<AMQQVAL2
DO S1
+8 QUIT
+9 ;
S1 SET AMQQLCNT=AMQQLCNT+1
+1 SET AMQQHOLD=AMQQHOLD+1
+2 SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-$PIECE(AMQQVDAT,"."))_U_AMQQVSIT_U_AMQQVNO
+3 QUIT
+4 ;
LASTEVAL ;EVALUATE 'LAST' CONDITION
+1 KILL AMQQQUIT
+2 SET AMQP(1)=AMQQVSIT
+3 XECUTE AMQV("QQ",1,1)
+4 IF '$GET(AMQT(1))
SET AMQQLAST=AMQQLAST+1
QUIT
+5 SET AMQQQUIT=""
+6 QUIT
