AMQQMULT ;IHS/CMI/THL - COLLECTS MULTIPLE VALUES ;
;;2.0;IHS PCC SUITE;**2,4**;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)
I '$D(AMQQAG) S AMQQAG="AG"
I '$D(AMQQSQVN) S AMQQ=U_AMQQGR_"(""AA"",AMQP(0))"
E S AMQQ=U_AMQQGR_"(""AD"","_AMQQSQVN_")",%=+^AUPNVSIT(AMQQSQVN,0) G:'% EXIT S AMQQVDAT=(9999999-%)\1
S AMQQSPEC=""
I AMQQVAL1["~~" S AMQQSPEC=AMQQVAL2,AMQQVAL2=$P(AMQQVAL1,"~~",2),AMQQVAL1=$P(AMQQVAL1,"~~")
I AMQQVAL2="ANY"!((AMQQVAL1=-999999999)&(AMQQVAL2=999999999)) S AMQQAAFL=""
S AMQQMSS=+AMQQMSS
S AMQQMPC=$S(AMQQMPC:AMQQMPC,1:4)
S AMQQHOLD=0
S AMQT(AMQQT)=0
S AMQQIDN=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(AMQQB) S %=AMQQB,AMQQBOOL=$P(%,";"),AMQQVAL3=$P(%,";",2),AMQQVAL4=$P(%,";",3)
I $D(AMQQSQVN),AMQQID[":" G:$D(@AMQQ) RUN S AMQT(AMQQT)=0 G NULL
I '$D(AMQQSQVN),AMQQID'[":",'$D(@AMQQ@(AMQQID\1)),AMQQ["VLAB" 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 D ID
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",$G(AMQQVAL2)'="ANY"
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
;
ID I AMQQID'[":" S AMQQIDX=AMQQID D INC Q
F S AMQQIDN=AMQQIDN+1,AMQQIDX=$P(AMQQID,":",AMQQIDN) Q:AMQQIDX="" D INC I AMQQLCNT=-1 Q
Q
;
INC I AMQQGR="AUPNVLAB",AMQQIDX["." S AMQQLSS=+$P(AMQQIDX,".",2,99),AMQQIDX=AMQQIDX\1
I $D(AMQQSQVN) S AMQQVNO=0 D VINC Q
I '$D(@AMQQ@(AMQQIDX)) Q
S AMQQVDAT=9999999-AMQQFIN
INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQIDX,AMQQVDAT))
I AMQQVDAT'=+AMQQVDAT Q
I (9999999-AMQQVDAT)<AMQQST Q
S AMQQVNO=0
INCITEM S AMQQVNO=$O(@AMQQ@(AMQQIDX,AMQQVDAT,AMQQVNO))
I 'AMQQVNO G INCDATE
;IHS/CMI/LAB - EXCLUDE MEASUREMENTS ENTERED IN ERROR
;S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")" G:'$D(@%) INCITEM G:'$D(^(0)) INCITEM I AMQQGR="AUPNVLAB" D LABSITE I $G(AMQQLSS1)="UNSPECIFIED SOURCE" G INCITEM
S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
I AMQQGR="AUPNVMSR" G:$P($G(^AUPNVMSR(+AMQQVNO,2)),U,1) INCITEM ;if entered in error skip it
G:'$D(@%) INCITEM G:'$D(^(0)) INCITEM I AMQQGR="AUPNVLAB" D LABSITE I $G(AMQQLSS1)="UNSPECIFIED SOURCE" G INCITEM
S AMQQVALU=$P(@%,U,AMQQMPC)
S AMQQVSIT=$P(^(0),U,3)
S AMQQXXXX=AMQQMPC_U_%_U_@%
I AMQQGR="AUPNVXAM"!(AMQQGR="AUPNVNTS"),AMQQVXAM'="ALL",AMQQVXAM'=AMQQVALU Q ;PATCH XXX
D SET
CNT I AMQQLCNT=AMQQLAST D LASTEVAL I $D(AMQQQUIT) K AMQQQUIT Q
I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1 Q
G INCITEM
;
SET I AMQQVAL1="A",AMQQGR="AUPNVIMM",AMQQVALU="" S AMQQVALU=$P($G(^AUTTIMM(AMQQIDX,0)),U,2)_" +" G S1
I AMQQVALU="",$D(AMQQAAFL) S AMQQVALU=" " D S1 Q
I "<>"[$E(AMQQVALU) S AMQQGTLT=$E(AMQQVALU),AMQQVALU=$E(AMQQVALU,2,99)
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 $D(AMQQB) X "I 0" D BP^AMQQMULN D:$T S1 Q
I AMQQVAL2'=+AMQQVAL2 D TEXT^AMQQFAN D:$T S1 Q
S AMQQVALU=$S(AMQQVALU="":" ",1:+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 %=""
I AMQQGR="AUPNVLAB" S %=$P($G(^AUPNVLAB(AMQQVNO,0)),U,5) I $G(AMQQLSS)=44 S %="" ;_" "_AMQQLSS1
I AMQQGR="AUPNVDXP" S %=$P($G(^AUPNVDXP(AMQQVNO,0)),U,5)
I AMQQVALU'=" ",%]"" S AMQQVALU=AMQQVALU_" "_% S AMQQLDFN=AMQQIDX
I $D(AMQQGTLT) S AMQQVALU=AMQQGTLT_AMQQVALU K AMQQGTLT
S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
Q
;
VINC S AMQQVNO=$O(@AMQQ@(AMQQVNO))
I 'AMQQVNO Q
S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
I $D(@%),$D(^(0)),$P(^(0),U)=AMQQIDX S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC),AMQQVSIT=$P(^(0),U,3) D SET I 1
E G VINC
I AMQQLCNT=AMQQLAST Q
I AMQQSPEC="EXISTS"!(AMQQSPEC="NULL"),AMQQLCNT S AMQQLCNT=-1 Q
G VINC
;
LABSITE ;
N %,X
S AMQQLSS1="NO SITE SPECIMEN"
Q:'$D(AMQQLSS)
I AMQQLSS=44 S:$P($G(^AUPNVLAB(+$G(AMQQVNO),11)),U,3) AMQQLSS1="UNSPECIFIED SOURCE" Q
I $G(AMQQIDX),$D(^AMQQ(5,(AMQQIDX+1000.44),0)),AMQQLSS'=44,'$P($G(^AUPNVLAB(+$G(AMQQVNO),11)),U,3) S AMQQLSS1="UNSPECIFIED SOURCE" Q
F %=1:1 S X=+$P(AMQQLSS,".",%) Q:'X I X=$P($G(^AUPNVLAB(AMQQVNO,11)),U,3) S:$G(^LAB(61,X,0))'="" AMQQLSS1=$P(^LAB(61,X,0),U) Q
Q
;
LASTEVAL ;EP;EVALUATE 'LAST' CONDITION
K AMQQQUIT
I '$D(AMQV("QQ",1,1)) S AMQQQUIT="" Q
I AMQV("QQ",1,1)["%=+$G(^AUPNVSIT(" S AMQQQUIT="" Q
K AMQQQUIT
S AMQP(1)=AMQQVSIT
X AMQV("QQ",1,1)
I '$G(AMQT(1)) S AMQQLAST=AMQQLAST+1 Q
S AMQQQUIT=""
Q
AMQQMULT ;IHS/CMI/THL - COLLECTS MULTIPLE VALUES ;
+1 ;;2.0;IHS PCC SUITE;**2,4**;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 IF '$DATA(AMQQAG)
SET AMQQAG="AG"
+4 IF '$DATA(AMQQSQVN)
SET AMQQ=U_AMQQGR_"(""AA"",AMQP(0))"
+5 IF '$TEST
SET AMQQ=U_AMQQGR_"(""AD"","_AMQQSQVN_")"
SET %=+^AUPNVSIT(AMQQSQVN,0)
IF '%
GOTO EXIT
SET AMQQVDAT=(9999999-%)\1
+6 SET AMQQSPEC=""
+7 IF AMQQVAL1["~~"
SET AMQQSPEC=AMQQVAL2
SET AMQQVAL2=$PIECE(AMQQVAL1,"~~",2)
SET AMQQVAL1=$PIECE(AMQQVAL1,"~~")
+8 IF AMQQVAL2="ANY"!((AMQQVAL1=-999999999)&(AMQQVAL2=999999999))
SET AMQQAAFL=""
+9 SET AMQQMSS=+AMQQMSS
+10 SET AMQQMPC=$SELECT(AMQQMPC:AMQQMPC,1:4)
+11 SET AMQQHOLD=0
+12 SET AMQT(AMQQT)=0
+13 SET AMQQIDN=0
+14 SET AMQQLCNT=0
+15 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+16 IF $EXTRACT(AMQQST)?1P
IF '$DATA(AMQQSQVN)
DO REL^AMQQMULS
+17 IF AMQQMULZ
SET AMQQMUNV=AMQQNVAR
SET AMQQMUFV=AMQQFVAR
SET AMQQMULL=AMQQMULZ
+18 IF $DATA(AMQQB)
SET %=AMQQB
SET AMQQBOOL=$PIECE(%,";")
SET AMQQVAL3=$PIECE(%,";",2)
SET AMQQVAL4=$PIECE(%,";",3)
+19 IF $DATA(AMQQSQVN)
IF AMQQID[":"
IF $DATA(@AMQQ)
GOTO RUN
SET AMQT(AMQQT)=0
GOTO NULL
+20 IF '$DATA(AMQQSQVN)
IF AMQQID'[":"
IF '$DATA(@AMQQ@(AMQQID\1))
IF AMQQ["VLAB"
SET AMQT(AMQQT)=0
GOTO NULL
+21 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 DO ID
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"
IF AMQQSPEC'="ANY"
IF $GET(AMQQVAL2)'="ANY"
+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 ;
ID IF AMQQID'[":"
SET AMQQIDX=AMQQID
DO INC
QUIT
+1 FOR
SET AMQQIDN=AMQQIDN+1
SET AMQQIDX=$PIECE(AMQQID,":",AMQQIDN)
IF AMQQIDX=""
QUIT
DO INC
IF AMQQLCNT=-1
QUIT
+2 QUIT
+3 ;
INC IF AMQQGR="AUPNVLAB"
IF AMQQIDX["."
SET AMQQLSS=+$PIECE(AMQQIDX,".",2,99)
SET AMQQIDX=AMQQIDX\1
+1 IF $DATA(AMQQSQVN)
SET AMQQVNO=0
DO VINC
QUIT
+2 IF '$DATA(@AMQQ@(AMQQIDX))
QUIT
+3 SET AMQQVDAT=9999999-AMQQFIN
INCDATE SET AMQQVDAT=$ORDER(@AMQQ@(AMQQIDX,AMQQVDAT))
+1 IF AMQQVDAT'=+AMQQVDAT
QUIT
+2 IF (9999999-AMQQVDAT)<AMQQST
QUIT
+3 SET AMQQVNO=0
INCITEM SET AMQQVNO=$ORDER(@AMQQ@(AMQQIDX,AMQQVDAT,AMQQVNO))
+1 IF 'AMQQVNO
GOTO INCDATE
+2 ;IHS/CMI/LAB - EXCLUDE MEASUREMENTS ENTERED IN ERROR
+3 ;S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")" G:'$D(@%) INCITEM G:'$D(^(0)) INCITEM I AMQQGR="AUPNVLAB" D LABSITE I $G(AMQQLSS1)="UNSPECIFIED SOURCE" G INCITEM
+4 SET %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
+5 ;if entered in error skip it
IF AMQQGR="AUPNVMSR"
IF $PIECE($GET(^AUPNVMSR(+AMQQVNO,2)),U,1)
GOTO INCITEM
+6 IF '$DATA(@%)
GOTO INCITEM
IF '$DATA(^(0))
GOTO INCITEM
IF AMQQGR="AUPNVLAB"
DO LABSITE
IF $GET(AMQQLSS1)="UNSPECIFIED SOURCE"
GOTO INCITEM
+7 SET AMQQVALU=$PIECE(@%,U,AMQQMPC)
+8 SET AMQQVSIT=$PIECE(^(0),U,3)
+9 SET AMQQXXXX=AMQQMPC_U_%_U_@%
+10 ;PATCH XXX
IF AMQQGR="AUPNVXAM"!(AMQQGR="AUPNVNTS")
IF AMQQVXAM'="ALL"
IF AMQQVXAM'=AMQQVALU
QUIT
+11 DO SET
CNT IF AMQQLCNT=AMQQLAST
DO LASTEVAL
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 AMQQVAL1="A"
IF AMQQGR="AUPNVIMM"
IF AMQQVALU=""
SET AMQQVALU=$PIECE($GET(^AUTTIMM(AMQQIDX,0)),U,2)_" +"
GOTO S1
+1 IF AMQQVALU=""
IF $DATA(AMQQAAFL)
SET AMQQVALU=" "
DO S1
QUIT
+2 IF "<>"[$EXTRACT(AMQQVALU)
SET AMQQGTLT=$EXTRACT(AMQQVALU)
SET AMQQVALU=$EXTRACT(AMQQVALU,2,99)
+3 IF AMQQITR'=""
SET X=AMQQVALU
XECUTE AMQQITR
SET AMQQVALU=X
+4 IF $DATA(AMQQNNA)
IF AMQQNNA>1
XECUTE "I 0"
DO ^AMQQMULN
IF $TEST
DO S1
QUIT
+5 IF $DATA(AMQQB)
XECUTE "I 0"
DO BP^AMQQMULN
IF $TEST
DO S1
QUIT
+6 IF AMQQVAL2'=+AMQQVAL2
DO TEXT^AMQQFAN
IF $TEST
DO S1
QUIT
+7 SET AMQQVALU=$SELECT(AMQQVALU="":" ",1:+AMQQVALU)
+8 IF AMQQVAL1>AMQQVAL2
IF AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1)
DO S1
QUIT
+9 IF AMQQVALU=AMQQVAL1
IF AMQQVALU=AMQQVAL2
DO S1
QUIT
+10 IF AMQQVALU>AMQQVAL1
IF AMQQVALU<AMQQVAL2
DO S1
+11 QUIT
+12 ;
S1 SET AMQQLCNT=AMQQLCNT+1
+1 SET AMQQHOLD=AMQQHOLD+1
+2 SET %=""
+3 ;_" "_AMQQLSS1
IF AMQQGR="AUPNVLAB"
SET %=$PIECE($GET(^AUPNVLAB(AMQQVNO,0)),U,5)
IF $GET(AMQQLSS)=44
SET %=""
+4 IF AMQQGR="AUPNVDXP"
SET %=$PIECE($GET(^AUPNVDXP(AMQQVNO,0)),U,5)
+5 IF AMQQVALU'=" "
IF %]""
SET AMQQVALU=AMQQVALU_" "_%
SET AMQQLDFN=AMQQIDX
+6 IF $DATA(AMQQGTLT)
SET AMQQVALU=AMQQGTLT_AMQQVALU
KILL AMQQGTLT
+7 SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
+8 QUIT
+9 ;
VINC SET AMQQVNO=$ORDER(@AMQQ@(AMQQVNO))
+1 IF 'AMQQVNO
QUIT
+2 SET %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
+3 IF $DATA(@%)
IF $DATA(^(0))
IF $PIECE(^(0),U)=AMQQIDX
SET AMQQVALU=$PIECE(^(AMQQMSS),U,AMQQMPC)
SET AMQQVSIT=$PIECE(^(0),U,3)
DO SET
IF 1
+4 IF '$TEST
GOTO VINC
+5 IF AMQQLCNT=AMQQLAST
QUIT
+6 IF AMQQSPEC="EXISTS"!(AMQQSPEC="NULL")
IF AMQQLCNT
SET AMQQLCNT=-1
QUIT
+7 GOTO VINC
+8 ;
LABSITE ;
+1 NEW %,X
+2 SET AMQQLSS1="NO SITE SPECIMEN"
+3 IF '$DATA(AMQQLSS)
QUIT
+4 IF AMQQLSS=44
IF $PIECE($GET(^AUPNVLAB(+$GET(AMQQVNO),11)),U,3)
SET AMQQLSS1="UNSPECIFIED SOURCE"
QUIT
+5 IF $GET(AMQQIDX)
IF $DATA(^AMQQ(5,(AMQQIDX+1000.44),0))
IF AMQQLSS'=44
IF '$PIECE($GET(^AUPNVLAB(+$GET(AMQQVNO),11)),U,3)
SET AMQQLSS1="UNSPECIFIED SOURCE"
QUIT
+6 FOR %=1:1
SET X=+$PIECE(AMQQLSS,".",%)
IF 'X
QUIT
IF X=$PIECE($GET(^AUPNVLAB(AMQQVNO,11)),U,3)
IF $GET(^LAB(61,X,0))'=""
SET AMQQLSS1=$PIECE(^LAB(61,X,0),U)
QUIT
+7 QUIT
+8 ;
LASTEVAL ;EP;EVALUATE 'LAST' CONDITION
+1 KILL AMQQQUIT
+2 IF '$DATA(AMQV("QQ",1,1))
SET AMQQQUIT=""
QUIT
+3 IF AMQV("QQ",1,1)["%=+$G(^AUPNVSIT("
SET AMQQQUIT=""
QUIT
+4 KILL AMQQQUIT
+5 SET AMQP(1)=AMQQVSIT
+6 XECUTE AMQV("QQ",1,1)
+7 IF '$GET(AMQT(1))
SET AMQQLAST=AMQQLAST+1
QUIT
+8 SET AMQQQUIT=""
+9 QUIT
