Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMEROUT4

AMEROUT4.m

Go to the documentation of this file. 
  1. AMEROUT4 ; IHS/ANMC/GIS - HOURLY WORKLOAD REPORTS ; 
  1.  ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
  1.  ;
  1. NEW N X,Y,Z,%,AMERHSRT,DN1,DN2,DDB,AMERFLTR S AMERFLTR=0
  1.  K ^TMP("AMER HOUR",$J),^TMP("AMER HF",$J),^TMP("AMER PRINT",$J)
  1. RUN D SORT I $D(AMERQUIT) G EXIT
  1.  D FILTER^AMEROUT5 I $D(AMERQUIT) G EXIT
  1.  ;
  1.  ; Allow user to pick a shift to report on
  1.  S AMERSHFT=$$SHIFT()
  1.  I AMERSHFT'=-1 D
  1.  .D GET(AMERSHFT)
  1.  .D SUBTOT(AMERSHFT)
  1.  .D FORMAT(AMERSHFT)
  1.  .D ZIS^AMEROUT5
  1.  .Q
  1.  ;
  1. EXIT ;ENTRY POINT FROM AMEROUT5
  1.  K ^TMP("AMER HOUR",$J),^TMP("AMER TOT",$J),^TMP("AMER PRINT",$J)
  1.  Q
  1.  ;
  1. SORT ; SORT BY PROVIDER?
  1.  S DIR(0)="SO^1:SORT BY A SPECIFIC PROVIDER;2:SORT BY ALL PROVIDERS;3:DO NOT SORT BY PROVIDER",DIR("A")="Sort option",DIR("?")="",DIR("B")=3 D ^DIR K DIR
  1.  D OUT^AMEROUT I $D(AMERQUIT) Q
  1.  I Y=3 S AMERHSRT="" Q
  1.  I Y=2 S AMERHSRT=0 Q
  1.  N DIC S DIC="^VA(200,",DIC("A")="Enter PROVIDER NAME: ",DIC(0)="AEQM"
  1.  ; Screen so only providers with key can be selected
  1.  S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
  1.  D ^DIC,OUT^AMEROUT I $D(AMERQUIT) Q
  1.  I $G(Y)'>0 G SORT
  1.  S AMERHSRT=+Y
  1.  Q
  1.  ;
  1. GET(AMERSHFT) ; GET ENTRIES WITHIN THE SORT RANGES
  1.  N A,B,C,N,I,%,D,X,Y,Z
  1.  S D=$O(^AMERVSIT("B",AMERD1),-1),I=0
  1.  ; Looking at every visit time stamp, quitting if the time stamp is bigger than end date
  1.  F  S D=$O(^AMERVSIT("B",D)) Q:'D  Q:D>AMERD2  S N=0 F  S N=$O(^AMERVSIT("B",D,N)) Q:'N  S X=$G(^AMERVSIT(N,0)),Y=$G(^(6)) I X]"",Y]"" D
  1.  .I AMERHSRT,$P(Y,U,3)'=AMERHSRT Q
  1.  .; If we are sorting by provider, quit if this isn't the provider we are working with right now
  1.  .S %=+X
  1.  .; quit if this isn't the time range we are working with
  1.  .I $P(AMERSHFT,U,1)>+$E($P(%,".",2),1,2) Q
  1.  .I +$E($P(%,".",2),1,2)>$P(AMERSHFT,U,2) Q
  1.  .S I=I+1
  1.  .S A("TIME")=+$E($P(%,".",2),1,2),A("DAY")=$P(%,"."),%=$P(X,U,17),A("AGE")="" I % S A("AGE")=(%<14)
  1.  .S A("ETOH")=+$P($G(^AMERVSIT(N,11)),U)
  1.  .S A("TRAUMA")=($P($G(^AMERVSIT(N,3)),U)>0)
  1.  .S A("PRV")=$P(Y,U,3) I A("PRV")="" Q  ; MISSING PROVIDER
  1.  .S A("P TIME")=$P($G(^AMERVSIT(N,12)),U,3),A("T TIME")=$P($G(^(12)),U,4)
  1.  .I AMERFLTR D
  1.  ..S %=A("P TIME") I %,%>240 S A("P TIME")=""
  1.  ..S %=A("T TIME") I %,%<-5,%>120 S A("T TIME")=""
  1.  ..Q
  1.  .S %=A("AGE")_U_A("ETOH")_U_A("TRAUMA")_U_A("T TIME")_U_A("P TIME")
  1.  .S ^TMP("AMER HOUR",$J,$S(AMERHSRT="":0,1:A("PRV")),A("DAY"),A("TIME"),N)=%
  1.  .Q
  1.  Q
  1.  ;
  1. SUBTOT(AMERSHFT) ; COMPUTE THE HOURLY SUBTOTALS
  1.  N D,H,A,E,T,G,N,F,X,%,P,V,AMERPRV,AMERI
  1.  S G="^TMP(""AMER HOUR"",$J,AMERPRV)"
  1.  S AMERPRV="" F  S AMERPRV=$O(@G) Q:AMERPRV=""  S D=0 F  S D=$O(@G@(D)) Q:'D  D
  1.  .K F S AMERI=0
  1.  .; LOOP control modified to only total the selected shift
  1.  .F H=$P(AMERSHFT,U,1):1:$P(AMERSHFT,U,2) D
  1.  ..;IF THERE IS SOMETHING FOR THIS DATE AT THIS HOUR SET F(H)
  1.  ..I '$O(@G@(D,H,0)) S F(H)="" Q
  1.  ..K P,V S (A,E,T,P,V,N,I)=0
  1.  ..F  S N=$O(@G@(D,H,N)) Q:'N  S X=@G@(D,H,N) D
  1.  ...S AMERI=AMERI+1,I=I+1
  1.  ...S %=+X I % S A=A+1
  1.  ...S %=$P(X,U,2) I % S E=E+1
  1.  ...S %=$P(X,U,3) I % S T=T+1
  1.  ...S %=$P(X,U,4) I % D
  1.  ....S P=P+1
  1.  ....I P=1 S P(0)=%,P(1)=%,P(2)=% Q
  1.  ....S P(2)=P(2)+%
  1.  ....I %<P(0) S P(0)=% Q
  1.  ....I %>P(1) S P(1)=%
  1.  ....Q
  1.  ...S %=$P(X,U,5) I % D
  1.  ....S V=V+1
  1.  ....I V=1 S V(0)=%,V(1)=%,V(2)=% Q
  1.  ....S V(2)=V(2)+%
  1.  ....I %<V(0) S V(0)=% Q
  1.  ....I %>V(1) S V(1)=%
  1.  ....Q
  1.  ...Q
  1.  ..I P S %=P(2)/P,P(3)=$J(%,0,1)
  1.  ..I V S %=V(2)/V,V(3)=$J(%,0,1)
  1.  ..S %=I_U_A_U_E_U_T_U_$G(P(0))_U_$G(P(1))_U_$G(P(3))_U_$G(V(0))_U_$G(V(1))_U_$G(V(3))
  1.  ..S F(H)=%
  1.  ..Q
  1.  .S %=$S(AMERHSRT="":0,1:AMERPRV)
  1.  .M ^TMP("AMER TOT",$J,%,D)=F      ;M(ERGE) command
  1.  .D TOTALS(AMERPRV,AMERI,D)
  1.  .Q
  1.  Q
  1.  ;
  1. TOTALS(P,J,D) ; GET TOTALS AND AVERAGES FOR A GIVEN PROVIDER-DAY
  1.  ; 1=TOTAL,2=AGE<14,3=ETOH,4=TRAUMA,5=P MIN,6=P MAX,7=P AVE,8=T MIN,9=T MAX,10=T AVE
  1.  N X,H,%,I,T,J,K,L,M,R,Q
  1.  F I=1:1:10 S T(I)=0 I I>4 S T(I,0)=0
  1.  F I=11:1:16 S T(I)=""
  1.  S H="" F  S H=$O(F(H)) Q:H=""  S X=F(H) F I=1:1:10 I $P(X,U,I)]"" S T(I)=$P(X,U,I)+T(I) I I>4 S T(I,0)=T(I,0)+1
  1.  F I=5:1:10 S %=T(I,0) I % S %=T(I)/T(I,0),T(I+6)=$J(%,0,1)
  1.  S (J,K,L,M)=0,Q=""
  1.  F  S Q=$O(^TMP("AMER HOUR",$J,P,D,Q)) Q:'Q  S R=0 F  S R=$O(^TMP("AMER HOUR",$J,P,D,Q,R)) Q:'R  S Z=^(R),%=$P(Z,U,4) S:%]"" J=J+1,K=K+% S %=$P(Z,U,5) S:%]"" L=L+1,M=M+%
  1.  S T(13)="" I J S %=K/J,T(13)=$J(%,0,1)
  1.  S T(16)="" I L S %=M/L,T(16)=$J(%,0,1)
  1.  S ^TMP("AMER TOT",$J,P,D)=T(1)_U_T(2)_U_T(3)_U_T(4)_U_T(11)_U_T(12)_U_T(13)_U_T(14)_U_T(15)_U_T(16)
  1.  Q
  1.  ;
  1. FORMAT(AMERSHFT) ; CREATE FORMATTED OUTPUT AND STORE IN AN ARRAY
  1.  N A,B,C,X,Y,Z,%,I,J,H,L,S,OCXI
  1.  S OCXI=0
  1.  S A="VISIT TIME^# PTS^MINS TO TRIAGER ^MINS TO PROVIDER^AGE<14^ETOH^INJURY"
  1.  S B=0,J=0 F I=1:1:($L(A,U)-1) S X=$P(A,U,I),J=J+$L(X)+2,B=B_U_J
  1.  S C="" F I=1:1:$L(A,U) S X=$P(A,U,I) S:C]"" C=C_U S C=C_$L(X)
  1.  S H="" F I=1:1:$L(A,U) S:H]"" H=H_"  " S H=H_$P(A,U,I)
  1.  S %="MIN   MAX   AVE"
  1.  S X="",$P(X," ",$P(B,U,3)+1)="" S Z=X_%_"   "_%
  1.  S %="----  ----  ----"
  1.  S L="" F I=1:1:7 S X=$P(C,U,I) D
  1.  . I L]"" S L=L_"  "
  1.  . I I=3!(I=4) S L=L_% Q
  1.  . S Y="",$P(Y,"-",X+1)="",L=L_Y
  1.  . Q
  1.  I $O(^TMP("AMER TOT",$J,0)) D F1(AMERSHFT) Q
  1.  D F2(0,AMERSHFT)
  1.  Q
  1.  ;
  1. INC(X) ; STORE A PRINTABLE LINE IN THE ARRAY
  1.  S OCXI=OCXI+1
  1.  S ^TMP("AMER PRINT",$J,OCXI)=X
  1.  Q
  1.  ;
  1. F2(P,AMERSHFT) ; DATE SORT
  1.  N A,D,X,T,Y S D=0
  1.  F  S D=$O(^TMP("AMER TOT",$J,P,D)) Q:'D  D
  1.  .S Y=D X ^DD("DD") D INC(Y),INC(H),INC(Z),INC(L)
  1.  .S T="" F  S T=$O(^TMP("AMER TOT",$J,P,D,T)) Q:T=""  S X=^(T) D
  1.  ..I T=12 D
  1.  ...D INC("<>")
  1.  ...I $P($G(AMERSHFT),U,3)=0 D INC(H),INC(Z),INC(L)
  1.  ..S A=$$HOUR(T)_"   "_$J(+X,$P(C,U,2))_"  "
  1.  ..; Only print if not "daily"
  1.  ..I X=""&$P($G(AMERSHFT),U,3)=0 D INC(A) Q
  1.  ..F I=5:1:7 S %=$P(X,U,I) S:% %=%\1,%=$J(%,4),A=A_%_"  "
  1.  ..F I=8:1:10 S %=$P(X,U,I) S:% %=%\1,%=$J(%,4),A=A_%_"  "
  1.  ..F I=2:1:4 S %=$P(X,U,I),%=$J(%,$P(C,U,I+3)) S A=A_%_"  "
  1.  ..; Only print if not "daily"
  1.  ..I $P($G(AMERSHFT),U,3)=0 D INC(A)
  1.  ..Q
  1.  .D F3(P,D)
  1.  .Q
  1.  Q
  1.  ;
  1. F1(AMERSHFT) ; PROVIDER LOOP
  1.  N P S P=0
  1.  F  S P=$O(^TMP("AMER TOT",$J,P)) Q:'P  D:$O(^(P),-1) INC("<>") D INC($P(^VA(200,P,0),U)),F2(P,AMERSHFT)
  1.  Q
  1.  ; 
  1. HOUR(X) ; CONVERT TIME TO HOUR RANGE
  1.  N Y,Z,%
  1.  I X=24 S X=0
  1.  S Y=X_"00" I $L(Y)=3 S Y="0"_Y
  1.  S Z=X_"59" I $L(Z)=3 S Z="0"_Z
  1.  S %=Y_"-"_Z
  1.  Q %
  1.  ;
  1. F3(P,D) ; TOTALS
  1.  N X,Y,Z,%,A,I
  1.  S X=$G(^TMP("AMER TOT",$J,P,D)) I X="" Q
  1.  S A="TOTALS      "_$J(+X,5)
  1.  S %="",$P(%," ",39)="",A=A_%
  1.  F I=2:1:4 S %=$P(X,U,I),%=$J(+%,$P(C,U,I+3))_"  " S A=A_%
  1.  D INC(" "),INC(A)
  1.  S A="AVERAGES           "
  1.  F I=5:1:10 S %=$P(X,U,I) S:%]"" %=%\1 S %=$J(%,4)_"  " S A=A_%
  1.  D INC(A)
  1.  Q
  1.  ;
  1. SHIFT() ;Allow user to select "DAILY TOTALS ONLY"
  1.  ; OR
  1.  ; Allow a start and stop military hour to be selected 
  1.  N DIR,AMERTEMP,AMERRTRN,AMERSHOW,Y
  1.  ; If daily totals are desired return 24 hour shift and a flag and quit
  1.  S DIR("A")="Report daily totals only"
  1.  S DIR(0)="Y",DIR("B")="YES"
  1.  D ^DIR
  1.  I Y=1 S AMERRTRN="00^23^1" Q AMERRTRN
  1.  ; Daily totals are not desired, so allow START and STOP hour to be selected
  1.  S DIR("B")=24
  1.  S DIR(0)="N^1:24:0",DIR("A")="Enter STARTING hour",DIR("?")="Enter a number between 1-24"
  1.  D ^DIR
  1.  I Y=""!(Y="^") S AMERRTRN=-1
  1.  E  D
  1.  .S:Y=24 Y="00"
  1.  .S AMERRTRN=Y
  1.  .S AMERSHOW=Y_"00" I $L(AMERSHOW)=3 S AMERSHOW="0"_AMERSHOW
  1.  .Q
  1.  I AMERRTRN=-1 Q AMERRTRN
  1.  S DIR("B")=24
  1.  S DIR(0)="N^1:24:0",DIR("A")="Enter ENDING hour",DIR("?")="Enter a number between 1-24"
  1.  D ^DIR
  1.  I Y=""!(Y="^") S AMERRTRN=-1 Q AMERRTRN
  1.  E  D
  1.  .S Y=Y-1
  1.  .S:Y=0 Y="00"
  1.  .S AMERRTRN=AMERRTRN_"^"_Y
  1.  .S AMERTEMP=Y_"59" I $L(AMERTEMP)=3 S AMERTEMP="0"_AMERTEMP
  1.  .S AMERSHOW=AMERSHOW_"^"_AMERTEMP
  1.  .Q
  1.  S AMERRTRN=AMERRTRN_"^0"
  1.  D EN^DDIOL("Reporting from: "_$P(AMERSHOW,U,1)_" to: "_$P(AMERSHOW,U,2),"","!!")
  1.  Q AMERRTRN