- AMQQMUL1 ; IHS/CMI/THL - COLLECT MULTIPLE VALUES FOR POVS, PROCEDURES, ETC. ;
- ;;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(^TMP("AMQQ",$J,+$G(AMQP(.1)),AMQP(0))) S AMQT(AMQQT)=0 Q ;TEMP FOR REGISTER TESTING
- I '$D(AMQQAG) S AMQQAG="AG"
- I '$D(AMQQSQVN) S AMQQ=U_AMQQGR_"(""A"_$S(AMQQGR="AUPNVPRV":"C",1:"A")_""",AMQP(0))"
- E S AMQQ=U_AMQQGR_"(""AD"","_AMQQSQVN_")",%=+^AUPNVSIT(AMQQSQVN,0) G:'% EXIT S AMQQVDAT=(9999999-%)\1,AMQQVSIT=AMQQSQVN
- S AMQQVAL1=+AMQQVAL1
- S AMQQMSS=+AMQQMSS
- S AMQQMPC=AMQQMPC+'AMQQMPC
- 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 I '$D(AMQQSQVN),AMQQGR="AUPNVHF" D HINC G SQ
- I $G(AMQP(0)),$G(AMQQONE)]""!($G(AMQV(1))["DIBT("),$G(AMQP(.1))="","^AUPNVRAD^AUPNVCPT^AUPNVDXP^AUPNVMSR^"[(U_AMQQGR_U),$D(^UTILITY("AMQQ TAX",$J)) D AMQP G SQ
- I '$D(AMQQSQVN),AMQQGR'="AUPNVPRV" D INC G SQ
- S AMQQVNO=0
- D VINC
- 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",AMQQ'["AUPNVIF" 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 I "^AUPNVRAD^AUPNVCPT^AUPNVDXP^AUPNVMSR^"'[(U_AMQQGR_U) S AMQQVDAT=$O(@AMQQ@(AMQQVDAT))
- E S AMQQVDAT=$O(@AMQQ@($S('$G(AMQP(99.1)):AMQP(.1),1:AMQP(99.1)),AMQQVDAT))
- I AMQQVDAT'=+AMQQVDAT Q
- I (9999999-AMQQVDAT)'>AMQQST Q
- S AMQQVNO=0
- INCITEM S AMQQVNO=$S(AMQQGR'["AUPNVRAD"&(AMQQGR'["AUPNVCPT")&(AMQQGR'["VDXP")&(AMQQGR'["VMSR"):$O(@AMQQ@(AMQQVDAT,AMQQVNO)),1:$O(@AMQQ@($S('$G(AMQP(99.1)):AMQP(.1),1:AMQP(99.1)),AMQQVDAT,AMQQVNO)))
- I 'AMQQVNO G INCDATE
- I AMQQGR="AUPNVPOV",'$D(AMQP(3)) S AMQP(3)=AMQQVNO
- S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
- I $D(@%),$D(^(0)) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC),AMQQVSIT=$P(^(0),U,3) D SET I 1
- E G INCITEM
- I AMQQLCNT=AMQQLAST D LASTEVAL^AMQQMULT I $D(AMQQQUIT) K AMQQQUIT Q
- I AMQQSPEC="EXISTS"&(AMQQ'["AUPNVIF")!(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
- ;
- VINC S AMQQVNO=$O(@AMQQ@(AMQQVNO))
- I 'AMQQVNO Q
- S %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
- I $D(@%),$D(^(0)) S AMQQVALU=$P(^(AMQQMSS),U,AMQQMPC) S:AMQQGR="AUPNVPRV" AMQQVSIT=$P(^(0),U,3),AMQQVDAT=9999999-(+^AUPNVSIT(AMQQVSIT,0)) D SET I 1
- E G VINC
- I AMQQLCNT=AMQQLAST Q
- I AMQQSPEC="NULL"!(AMQQSPEC="EXISTS")!(AMQQSPEC="INVERSE") Q
- G VINC
- ;
- HINC N AMQQHFNO,AMQQOLD
- S AMQQOLD=AMQQ
- N AMQQ
- S AMQQ=U_AMQQGR_"(""AA"",AMQP(0),AMQQHFNO)"
- F AMQQHFNO=0:0 S AMQQHFNO=$O(@AMQQOLD@(AMQQHFNO)) Q:'AMQQHFNO D INC
- Q
- ;
- CHS ; ENTRY POINT FROM METADICTIONARY
- I '$D(AMQQAG) S AMQQAG="AG"
- N Y,Z,%
- S X=""
- S %=^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)
- S Z=^AUPNVCHS($P(%,U,4),0)
- I %=""!(Z="") S X="??" Q
- S Y=$P(%,U,4)
- I Y'="" S X="#"_Y_" "
- S Y=$P(%,U,2)
- I Y X ^DD("DD") S X=X_Y_" "
- S Y=$P(Z,U,14)
- I Y S Y=$P(^AUTTVNDR(Y,0),U),Y=$E(Y,1,12) I Y'="" S X=X_Y_" "
- D LOS
- I Y'="" S X=X_"("_Y_" days) "
- S Y=$P(Z,U,6)
- I Y'="" S X=X_"$"_Y
- Q
- ;
- LOS S Y=%
- N H,%,%H,%Y,%T,X,Z
- S %=Y
- S Y=$P(%,U,2)
- S Z=$P(%,U,4)
- S Z=$P(^AUPNVCHS(Z,0),U,7)
- I 'Z!('Y) S Y="" Q
- F X=Z,Y D H^%DTC S:$D(Z) H=+%H S:'$D(Z) Y=H-(+%H) K Z
- Q
- AMQP ;
- N XXX,YYY
- S XXX=0
- F S XXX=$O(^UTILITY("AMQQ TAX",$J,XXX)) Q:'XXX D
- .S AMQP(.1)=$O(^UTILITY("AMQQ TAX",$J,XXX,""))
- .I AMQP(.1)="*" D AMQPALL Q
- .S AMQP(.1)=0
- .F S AMQP(.1)=$O(^UTILITY("AMQQ TAX",$J,XXX,AMQP(.1))) Q:'AMQP(.1) D INC
- Q
- AMQPALL ;
- S YYY=U_AMQQGR_"(""B"")"
- S AMQP(.1)=0
- F S AMQP(.1)=$O(@YYY@(AMQP(.1))) Q:'AMQP(.1) D INC
- Q
- AMQQMUL1 ; IHS/CMI/THL - COLLECT MULTIPLE VALUES FOR POVS, PROCEDURES, ETC. ;
- +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 ;TEMP FOR REGISTER TESTING
- IF $DATA(^TMP("AMQQ",$JOB,+$GET(AMQP(.1)),AMQP(0)))
- SET AMQT(AMQQT)=0
- QUIT
- +4 IF '$DATA(AMQQAG)
- SET AMQQAG="AG"
- +5 IF '$DATA(AMQQSQVN)
- SET AMQQ=U_AMQQGR_"(""A"_$SELECT(AMQQGR="AUPNVPRV":"C",1:"A")_""",AMQP(0))"
- +6 IF '$TEST
- SET AMQQ=U_AMQQGR_"(""AD"","_AMQQSQVN_")"
- SET %=+^AUPNVSIT(AMQQSQVN,0)
- IF '%
- GOTO EXIT
- SET AMQQVDAT=(9999999-%)\1
- SET AMQQVSIT=AMQQSQVN
- +7 SET AMQQVAL1=+AMQQVAL1
- +8 SET AMQQMSS=+AMQQMSS
- +9 SET AMQQMPC=AMQQMPC+'AMQQMPC
- +10 SET AMQQHOLD=0
- +11 SET AMQT(AMQQT)=0
- +12 SET AMQQLCNT=0
- +13 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
- +14 IF $EXTRACT(AMQQST)?1P
- IF '$DATA(AMQQSQVN)
- DO REL^AMQQMULS
- +15 IF AMQQMULZ
- SET AMQQMUNV=AMQQNVAR
- SET AMQQMUFV=AMQQFVAR
- SET AMQQMULL=AMQQMULZ
- +16 IF '$DATA(AMQQSQVN)
- IF '$DATA(@AMQQ)
- SET AMQT(AMQQT)=0
- GOTO NULL
- +17 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 IF '$DATA(AMQQSQVN)
- IF AMQQGR="AUPNVHF"
- DO HINC
- GOTO SQ
- +1 IF $GET(AMQP(0))
- IF $GET(AMQQONE)]""!($GET(AMQV(1))["DIBT(")
- IF $GET(AMQP(.1))=""
- IF "^AUPNVRAD^AUPNVCPT^AUPNVDXP^AUPNVMSR^"[(U_AMQQGR_U)
- IF $DATA(^UTILITY("AMQQ TAX",$JOB))
- DO AMQP
- GOTO SQ
- +2 IF '$DATA(AMQQSQVN)
- IF AMQQGR'="AUPNVPRV"
- DO INC
- GOTO SQ
- +3 SET AMQQVNO=0
- +4 DO VINC
- 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"
- IF AMQQ'["AUPNVIF"
- 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 IF "^AUPNVRAD^AUPNVCPT^AUPNVDXP^AUPNVMSR^"'[(U_AMQQGR_U)
- SET AMQQVDAT=$ORDER(@AMQQ@(AMQQVDAT))
- +1 IF '$TEST
- SET AMQQVDAT=$ORDER(@AMQQ@($SELECT('$GET(AMQP(99.1)):AMQP(.1),1:AMQP(99.1)),AMQQVDAT))
- +2 IF AMQQVDAT'=+AMQQVDAT
- QUIT
- +3 IF (9999999-AMQQVDAT)'>AMQQST
- QUIT
- +4 SET AMQQVNO=0
- INCITEM SET AMQQVNO=$SELECT(AMQQGR'["AUPNVRAD"&(AMQQGR'["AUPNVCPT")&(AMQQGR'["VDXP")&(AMQQGR'["VMSR"):$ORDER(@AMQQ@(AMQQVDAT,AMQQVNO)),1:$ORDER(@AMQQ@($SELECT('$GET(AMQP(99.1)):AMQP(.1),1:AMQP(99.1)),AMQQVDAT,AMQQVNO)))
- +1 IF 'AMQQVNO
- GOTO INCDATE
- +2 IF AMQQGR="AUPNVPOV"
- IF '$DATA(AMQP(3))
- SET AMQP(3)=AMQQVNO
- +3 SET %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
- +4 IF $DATA(@%)
- IF $DATA(^(0))
- SET AMQQVALU=$PIECE(^(AMQQMSS),U,AMQQMPC)
- SET AMQQVSIT=$PIECE(^(0),U,3)
- DO SET
- IF 1
- +5 IF '$TEST
- GOTO INCITEM
- +6 IF AMQQLCNT=AMQQLAST
- DO LASTEVAL^AMQQMULT
- IF $DATA(AMQQQUIT)
- KILL AMQQQUIT
- QUIT
- +7 IF AMQQSPEC="EXISTS"&(AMQQ'["AUPNVIF")!(AMQQSPEC="NULL")
- IF AMQQLCNT
- IF '$DATA(AMQV("SQ"))
- SET AMQQLCNT=-1
- QUIT
- +8 GOTO INCITEM
- +9 ;
- 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 ;
- VINC SET AMQQVNO=$ORDER(@AMQQ@(AMQQVNO))
- +1 IF 'AMQQVNO
- QUIT
- +2 SET %=U_AMQQGR_"("_AMQQVNO_","_AMQQMSS_")"
- +3 IF $DATA(@%)
- IF $DATA(^(0))
- SET AMQQVALU=$PIECE(^(AMQQMSS),U,AMQQMPC)
- IF AMQQGR="AUPNVPRV"
- SET AMQQVSIT=$PIECE(^(0),U,3)
- SET AMQQVDAT=9999999-(+^AUPNVSIT(AMQQVSIT,0))
- DO SET
- IF 1
- +4 IF '$TEST
- GOTO VINC
- +5 IF AMQQLCNT=AMQQLAST
- QUIT
- +6 IF AMQQSPEC="NULL"!(AMQQSPEC="EXISTS")!(AMQQSPEC="INVERSE")
- QUIT
- +7 GOTO VINC
- +8 ;
- HINC NEW AMQQHFNO,AMQQOLD
- +1 SET AMQQOLD=AMQQ
- +2 NEW AMQQ
- +3 SET AMQQ=U_AMQQGR_"(""AA"",AMQP(0),AMQQHFNO)"
- +4 FOR AMQQHFNO=0:0
- SET AMQQHFNO=$ORDER(@AMQQOLD@(AMQQHFNO))
- IF 'AMQQHFNO
- QUIT
- DO INC
- +5 QUIT
- +6 ;
- CHS ; ENTRY POINT FROM METADICTIONARY
- +1 IF '$DATA(AMQQAG)
- SET AMQQAG="AG"
- +2 NEW Y,Z,%
- +3 SET X=""
- +4 SET %=^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQHOLD)
- +5 SET Z=^AUPNVCHS($PIECE(%,U,4),0)
- +6 IF %=""!(Z="")
- SET X="??"
- QUIT
- +7 SET Y=$PIECE(%,U,4)
- +8 IF Y'=""
- SET X="#"_Y_" "
- +9 SET Y=$PIECE(%,U,2)
- +10 IF Y
- XECUTE ^DD("DD")
- SET X=X_Y_" "
- +11 SET Y=$PIECE(Z,U,14)
- +12 IF Y
- SET Y=$PIECE(^AUTTVNDR(Y,0),U)
- SET Y=$EXTRACT(Y,1,12)
- IF Y'=""
- SET X=X_Y_" "
- +13 DO LOS
- +14 IF Y'=""
- SET X=X_"("_Y_" days) "
- +15 SET Y=$PIECE(Z,U,6)
- +16 IF Y'=""
- SET X=X_"$"_Y
- +17 QUIT
- +18 ;
- LOS SET Y=%
- +1 NEW H,%,%H,%Y,%T,X,Z
- +2 SET %=Y
- +3 SET Y=$PIECE(%,U,2)
- +4 SET Z=$PIECE(%,U,4)
- +5 SET Z=$PIECE(^AUPNVCHS(Z,0),U,7)
- +6 IF 'Z!('Y)
- SET Y=""
- QUIT
- +7 FOR X=Z,Y
- DO H^%DTC
- IF $DATA(Z)
- SET H=+%H
- IF '$DATA(Z)
- SET Y=H-(+%H)
- KILL Z
- +8 QUIT
- AMQP ;
- +1 NEW XXX,YYY
- +2 SET XXX=0
- +3 FOR
- SET XXX=$ORDER(^UTILITY("AMQQ TAX",$JOB,XXX))
- IF 'XXX
- QUIT
- Begin DoDot:1
- +4 SET AMQP(.1)=$ORDER(^UTILITY("AMQQ TAX",$JOB,XXX,""))
- +5 IF AMQP(.1)="*"
- DO AMQPALL
- QUIT
- +6 SET AMQP(.1)=0
- +7 FOR
- SET AMQP(.1)=$ORDER(^UTILITY("AMQQ TAX",$JOB,XXX,AMQP(.1)))
- IF 'AMQP(.1)
- QUIT
- DO INC
- End DoDot:1
- +8 QUIT
- AMQPALL ;
- +1 SET YYY=U_AMQQGR_"(""B"")"
- +2 SET AMQP(.1)=0
- +3 FOR
- SET AMQP(.1)=$ORDER(@YYY@(AMQP(.1)))
- IF 'AMQP(.1)
- QUIT
- DO INC
- +4 QUIT
