- AMQQMULW ; IHS/CMI/THL - COLLECTS MULTIPLE VALUES FOR WOMEN'S HEALTH PROCEDURES ;
- ;;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=4
- S AMQQMSS=0
- S AMQQ=U_AMQQGR_"(""AA"",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 AMQQVDAT=9999999-AMQQFIN
- INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQVDAT))
- I AMQQVDAT'=+AMQQVDAT Q
- I (9999999-AMQQVDAT)'>AMQQST Q
- S AMQQVNO=0
- INCITEM S AMQQVNO=$O(@AMQQ@(AMQQVDAT,AMQQVNO))
- I 'AMQQVNO G INCDATE
- S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
- I $D(@%),$D(^(0)) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC),AMQQVSIT=+$P($G(^("PCC")),U) D SET I 1
- E G INCITEM
- 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="" 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_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
- K AMQQOK
- Q
- ;
- AMQQMULW ; IHS/CMI/THL - COLLECTS MULTIPLE VALUES FOR WOMEN'S HEALTH PROCEDURES ;
- +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=4
- +6 SET AMQQMSS=0
- +7 SET AMQQ=U_AMQQGR_"(""AA"",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
- 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 AMQQVDAT=9999999-AMQQFIN
- INCDATE SET AMQQVDAT=$ORDER(@AMQQ@(AMQQVDAT))
- +1 IF AMQQVDAT'=+AMQQVDAT
- QUIT
- +2 IF (9999999-AMQQVDAT)'>AMQQST
- QUIT
- +3 SET AMQQVNO=0
- INCITEM SET AMQQVNO=$ORDER(@AMQQ@(AMQQVDAT,AMQQVNO))
- +1 IF 'AMQQVNO
- GOTO INCDATE
- +2 SET %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
- +3 IF $DATA(@%)
- IF $DATA(^(0))
- SET AMQQVALU=$PIECE(^(AMQQMSS),U,AMQQMPC)
- SET AMQQVSIT=+$PIECE($GET(^("PCC")),U)
- DO SET
- IF 1
- +4 IF '$TEST
- GOTO INCITEM
- +5 IF AMQQLCNT=AMQQLAST
- DO LASTEVAL^AMQQMULT
- IF $DATA(AMQQQUIT)
- KILL AMQQQUIT
- QUIT
- +6 IF AMQQSPEC="EXISTS"!(AMQQSPEC="NULL")
- IF AMQQLCNT
- IF '$DATA(AMQV("SQ"))
- SET AMQQLCNT=-1
- QUIT
- +7 GOTO INCITEM
- +8 ;
- SET IF AMQQVALU=""
- QUIT
- +1 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_(9999999-AMQQVDAT)_U_AMQQVSIT_U_AMQQVNO
- +3 KILL AMQQOK
- +4 QUIT
- +5 ;
