AMQQMUL4 ; IHS/CMI/THL - HOSPITALIZATIONS ;
;;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)
I '$D(AMQQAG) S AMQQAG="AG"
S AMQQ="^AUPNVSIT(""AAH"","_AMQP(0)_")"
S AMQQMSS=+AMQQMSS
S AMQQMPC=AMQQMPC+'AMQQMPC
S AMQQHOLD=0
S AMQT(AMQQT)=0
S AMQQLCNT=0
S AMQQSPEC=""
S AMQQSPEC=""
I AMQQVAL1["~~" S AMQQSPEC=AMQQVAL2,AMQQVAL2=$P(AMQQVAL1,"~~",2),AMQQVAL1=$P(AMQQVAL1,"~~")
I '$D(AMQQAG) S AMQQAG="AG"
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
I '$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
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 S AMQQVDAT=9999999-AMQQFIN
INCDATE S AMQQVDAT=$O(@AMQQ@(AMQQVDAT))
I AMQQVDAT'=+AMQQVDAT Q
I (9999999-AMQQVDAT)'>AMQQST Q
S AMQQVSIT=0
INCVIS S AMQQVSIT=$O(@AMQQ@(AMQQVDAT,AMQQVSIT))
I 'AMQQVSIT G INCDATE
I '$D(^AUPNVSIT(AMQQVSIT)) G INCVIS
S AMQQVNO=0
INCINP S AMQQVNO=$O(^AUPNVINP("AD",AMQQVSIT,AMQQVNO))
S AMQQVALU=9999999-(AMQQVDAT\1)
S AMQQLCNT=AMQQLCNT+1
S AMQQHOLD=AMQQHOLD+1
S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_$G(AMQQVNO)
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 INCDATE
G INCINP
;
SUMMARY ; ENTRY POINT FROM METADICTIONARY
I '$D(AMQQAG) S AMQQAG="AG"
N Y,Z,% S X=""
S %=^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)
S Y=+%
I Y S Z(1)=Y X ^DD("DD")
I Y=0 S Y="??"
S X=X_Y_"=>"
S Y=$P(%,U,4)
S Y=+$G(^AUPNVINP(+Y,0))
I Y S Z(2)=Y X ^DD("DD")
I Y=0 S Y="NULL"
S X=X_Y
I $G(Z(2))]"",$G(Z(1))]"" D LOS I 1
E G SERVICE
S X=X_" ("_Y_" days) "
SERVICE S Y=$P(%,U,4)
S Y=$P($G(^AUPNVINP(+Y,0)),U,4)
I Y S Y=$P($G(^DIC(45.7,Y,0)),U) S Y=$E(Y,1,20)
S X=X_Y
Q
;
LOS N X,%H,%T,%Y,%
S X=Z(1)
D H^%DTC
S Z=+%H
S X=Z(2)
D H^%DTC
S Y=+%H-Z
Q
;
AMQQMUL4 ; IHS/CMI/THL - HOSPITALIZATIONS ;
+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 IF '$DATA(AMQQAG)
SET AMQQAG="AG"
+4 SET AMQQ="^AUPNVSIT(""AAH"","_AMQP(0)_")"
+5 SET AMQQMSS=+AMQQMSS
+6 SET AMQQMPC=AMQQMPC+'AMQQMPC
+7 SET AMQQHOLD=0
+8 SET AMQT(AMQQT)=0
+9 SET AMQQLCNT=0
+10 SET AMQQSPEC=""
+11 SET AMQQSPEC=""
+12 IF AMQQVAL1["~~"
SET AMQQSPEC=AMQQVAL2
SET AMQQVAL2=$PIECE(AMQQVAL1,"~~",2)
SET AMQQVAL1=$PIECE(AMQQVAL1,"~~")
+13 IF '$DATA(AMQQAG)
SET AMQQAG="AG"
+14 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+15 IF '$DATA(@AMQQ)
SET AMQT(AMQQT)=0
GOTO NULL
+16 IF $EXTRACT(AMQQST)?1P
IF '$DATA(AMQQSQVN)
DO REL^AMQQMULS
+17 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 SET AMQQVDAT=9999999-AMQQFIN
INCDATE SET AMQQVDAT=$ORDER(@AMQQ@(AMQQVDAT))
+1 IF AMQQVDAT'=+AMQQVDAT
QUIT
+2 IF (9999999-AMQQVDAT)'>AMQQST
QUIT
+3 SET AMQQVSIT=0
INCVIS SET AMQQVSIT=$ORDER(@AMQQ@(AMQQVDAT,AMQQVSIT))
+1 IF 'AMQQVSIT
GOTO INCDATE
+2 IF '$DATA(^AUPNVSIT(AMQQVSIT))
GOTO INCVIS
+3 SET AMQQVNO=0
INCINP SET AMQQVNO=$ORDER(^AUPNVINP("AD",AMQQVSIT,AMQQVNO))
+1 SET AMQQVALU=9999999-(AMQQVDAT\1)
+2 SET AMQQLCNT=AMQQLCNT+1
+3 SET AMQQHOLD=AMQQHOLD+1
+4 SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVALU_U_(9999999-AMQQVDAT)_U_AMQQVSIT_U_$GET(AMQQVNO)
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 INCDATE
+3 GOTO INCINP
+4 ;
SUMMARY ; ENTRY POINT FROM METADICTIONARY
+1 IF '$DATA(AMQQAG)
SET AMQQAG="AG"
+2 NEW Y,Z,%
SET X=""
+3 SET %=^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQHOLD)
+4 SET Y=+%
+5 IF Y
SET Z(1)=Y
XECUTE ^DD("DD")
+6 IF Y=0
SET Y="??"
+7 SET X=X_Y_"=>"
+8 SET Y=$PIECE(%,U,4)
+9 SET Y=+$GET(^AUPNVINP(+Y,0))
+10 IF Y
SET Z(2)=Y
XECUTE ^DD("DD")
+11 IF Y=0
SET Y="NULL"
+12 SET X=X_Y
+13 IF $GET(Z(2))]""
IF $GET(Z(1))]""
DO LOS
IF 1
+14 IF '$TEST
GOTO SERVICE
+15 SET X=X_" ("_Y_" days) "
SERVICE SET Y=$PIECE(%,U,4)
+1 SET Y=$PIECE($GET(^AUPNVINP(+Y,0)),U,4)
+2 IF Y
SET Y=$PIECE($GET(^DIC(45.7,Y,0)),U)
SET Y=$EXTRACT(Y,1,20)
+3 SET X=X_Y
+4 QUIT
+5 ;
LOS NEW X,%H,%T,%Y,%
+1 SET X=Z(1)
+2 DO H^%DTC
+3 SET Z=+%H
+4 SET X=Z(2)
+5 DO H^%DTC
+6 SET Y=+%H-Z
+7 QUIT
+8 ;
