- 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 ;
