- 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
