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
