- FHADR5 ; HISC/NCA - Dietetic Encounter Percentage ;4/27/93 09:20
- ;;5.5;DIETETICS;;Jan 28, 2005
- Q0 ; Calculate the Encounter Percentage
- K N,P,S,T2,T3,T4,T5 S (T2,T3,T4,T5)="",(CTN,NUM)=0
- F QR=1:1:4 S QTR=QR,PRE=FHYR_"0"_QTR_"00" D Q2^FHADRPT,Q1
- G EN2
- Q1 Q:'SDT!('EDT)
- S X1=SDT\1-.0001,X2=EDT\1+.3 K T,P
- Q2 S X1=$O(^FHEN("AT",X1)) I X1<1!(X1>X2) G ADD
- S K=0
- Q3 ; Count the Encounter and Work Units
- S K=$O(^FHEN("AT",X1,K)) G:K="" Q2
- S X=$G(^FHEN(K,0)),TYP=$P(X,"^",4) G:'TYP Q3
- S UNT=$P(X,"^",8)
- S:'$D(T(TYP)) T(TYP)=0 S T(TYP)=T(TYP)+1
- S:'$D(P(TYP)) P(TYP)=0 S P(TYP)=P(TYP)+UNT
- G Q3
- ADD F K=0:0 S K=$O(T(K)) Q:K<1 S TYP=$P($G(^FH(115.6,K,0)),"^",2) D A1
- Q
- A1 ; S(TYP) contains encounters, and N(TYP) contains the Work Units for
- ; four quarters T2 contains Total Encounters and T4 contains
- ; total Work Units of last line, CTN is YTD final encounters and
- ; NUM is YTD Units, T3 contains YTD Total encounters for each category
- ; T5 contains the YTD Total Units for each category
- Q:TYP=""
- S:'$D(S(TYP)) S(TYP)=""
- S $P(S(TYP),"^",QTR)=$P(S(TYP),"^",QTR)+T(K),CTN=CTN+T(K)
- S $P(T2,"^",QTR)=$P(T2,"^",QTR)+T(K) S:'$D(T3(TYP)) T3(TYP)=0
- S T3(TYP)=T3(TYP)+T(K)
- S:'$D(N(TYP)) N(TYP)="" S $P(N(TYP),"^",QTR)=$P(N(TYP),"^",QTR)+P(K)
- S $P(T4,"^",QTR)=$P(T4,"^",QTR)+P(K) S:'$D(T5(TYP)) T5(TYP)=0
- S T5(TYP)=T5(TYP)+P(K),NUM=NUM+P(K)
- Q
- EN2 ; Print the Encounters and Work Units
- D:$Y'<LIN HDR^FHADRPT D HDR
- S TIT=";"_$P(^DD(115.6,10,0),"^",3)
- P1 S Z=0 F K=0:0 S Z=$O(S(Z)) Q:Z="" S X=$F(TIT,";"_Z_":") S:X>0 X=$P($E(TIT,X,999),";",1) D P2
- S X="Total Encounters" D TOT Q
- P2 W !,?2,X,?28 F I=1:1:4 D LP
- W $J($S(+T3(Z)'<1:T3(Z),1:""),5)_" ",$S(T5(Z):$J(T5(Z),7,0),1:$J("",7))
- W $S(NUM:$J(T5(Z)/NUM*100,6,1),1:$J("",6)) Q
- LP W $J($S(+$P(S(Z),"^",I)'<1:$P(S(Z),"^",I),1:""),5)_" ",$S($P(N(Z),"^",I)'="":$J($P(N(Z),"^",I),7,0),1:$J("",7))
- W $S($P(T4,"^",I)'<1:$J($P(N(Z),"^",I)/$P(T4,"^",I)*100,6,1),1:$J("",6))_" "
- Q
- TOT ; Print Last Line
- W !!,X,?28 F I=1:1:4 W $J($S($P(T2,"^",I):$P(T2,"^",I),1:""),5)_" ",$S($P(T4,"^",I):$J($P(T4,"^",I),7,0),1:$J("",7))_$J("",7)
- W ?108,$J($S(CTN:CTN,1:""),5)_" ",$S(NUM:$J(NUM,7,0),1:$J("",7))
- K N,P,S,T2,T3,T4,T5 Q
- HDR ; Print Heading for Encounter Category Summary
- D:$Y'<(LIN-17) HDR^FHADRPT,HDR2^FHADR3A
- W !!!!,"CLINICAL ENCOUNTER CATEGORY SUMMARY"
- W !!,?35,"1st Qtr",?55,"2nd Qtr",?76,"3rd Qtr",?95,"4th Qtr",?116,"YTD"
- W !?36,"Work",?56,"Work",?76,"Work",?96,"Work",?116,"Work"
- W !,"Clinical Categories",?30,"Tot Units % Tot Units % Tot Units % Tot Units % Tot Units %",! Q
- FHADR5 ; HISC/NCA - Dietetic Encounter Percentage ;4/27/93 09:20
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- Q0 ; Calculate the Encounter Percentage
- +1 KILL N,P,S,T2,T3,T4,T5
- SET (T2,T3,T4,T5)=""
- SET (CTN,NUM)=0
- +2 FOR QR=1:1:4
- SET QTR=QR
- SET PRE=FHYR_"0"_QTR_"00"
- DO Q2^FHADRPT
- DO Q1
- +3 GOTO EN2
- Q1 IF 'SDT!('EDT)
- QUIT
- +1 SET X1=SDT\1-.0001
- SET X2=EDT\1+.3
- KILL T,P
- Q2 SET X1=$ORDER(^FHEN("AT",X1))
- IF X1<1!(X1>X2)
- GOTO ADD
- +1 SET K=0
- Q3 ; Count the Encounter and Work Units
- +1 SET K=$ORDER(^FHEN("AT",X1,K))
- IF K=""
- GOTO Q2
- +2 SET X=$GET(^FHEN(K,0))
- SET TYP=$PIECE(X,"^",4)
- IF 'TYP
- GOTO Q3
- +3 SET UNT=$PIECE(X,"^",8)
- +4 IF '$DATA(T(TYP))
- SET T(TYP)=0
- SET T(TYP)=T(TYP)+1
- +5 IF '$DATA(P(TYP))
- SET P(TYP)=0
- SET P(TYP)=P(TYP)+UNT
- +6 GOTO Q3
- ADD FOR K=0:0
- SET K=$ORDER(T(K))
- IF K<1
- QUIT
- SET TYP=$PIECE($GET(^FH(115.6,K,0)),"^",2)
- DO A1
- +1 QUIT
- A1 ; S(TYP) contains encounters, and N(TYP) contains the Work Units for
- +1 ; four quarters T2 contains Total Encounters and T4 contains
- +2 ; total Work Units of last line, CTN is YTD final encounters and
- +3 ; NUM is YTD Units, T3 contains YTD Total encounters for each category
- +4 ; T5 contains the YTD Total Units for each category
- +5 IF TYP=""
- QUIT
- +6 IF '$DATA(S(TYP))
- SET S(TYP)=""
- +7 SET $PIECE(S(TYP),"^",QTR)=$PIECE(S(TYP),"^",QTR)+T(K)
- SET CTN=CTN+T(K)
- +8 SET $PIECE(T2,"^",QTR)=$PIECE(T2,"^",QTR)+T(K)
- IF '$DATA(T3(TYP))
- SET T3(TYP)=0
- +9 SET T3(TYP)=T3(TYP)+T(K)
- +10 IF '$DATA(N(TYP))
- SET N(TYP)=""
- SET $PIECE(N(TYP),"^",QTR)=$PIECE(N(TYP),"^",QTR)+P(K)
- +11 SET $PIECE(T4,"^",QTR)=$PIECE(T4,"^",QTR)+P(K)
- IF '$DATA(T5(TYP))
- SET T5(TYP)=0
- +12 SET T5(TYP)=T5(TYP)+P(K)
- SET NUM=NUM+P(K)
- +13 QUIT
- EN2 ; Print the Encounters and Work Units
- +1 IF $Y'<LIN
- DO HDR^FHADRPT
- DO HDR
- +2 SET TIT=";"_$PIECE(^DD(115.6,10,0),"^",3)
- P1 SET Z=0
- FOR K=0:0
- SET Z=$ORDER(S(Z))
- IF Z=""
- QUIT
- SET X=$FIND(TIT,";"_Z_":")
- IF X>0
- SET X=$PIECE($EXTRACT(TIT,X,999),";",1)
- DO P2
- +1 SET X="Total Encounters"
- DO TOT
- QUIT
- P2 WRITE !,?2,X,?28
- FOR I=1:1:4
- DO LP
- +1 WRITE $JUSTIFY($SELECT(+T3(Z)'<1:T3(Z),1:""),5)_" ",$SELECT(T5(Z):$JUSTIFY(T5(Z),7,0),1:$JUSTIFY("",7))
- +2 WRITE $SELECT(NUM:$JUSTIFY(T5(Z)/NUM*100,6,1),1:$JUSTIFY("",6))
- QUIT
- LP WRITE $JUSTIFY($SELECT(+$PIECE(S(Z),"^",I)'<1:$PIECE(S(Z),"^",I),1:""),5)_" ",$SELECT($PIECE(N(Z),"^",I)'="":$JUSTIFY($PIECE(N(Z),"^",I),7,0),1:$JUSTIFY("",7))
- +1 WRITE $SELECT($PIECE(T4,"^",I)'<1:$JUSTIFY($PIECE(N(Z),"^",I)/$PIECE(T4,"^",I)*100,6,1),1:$JUSTIFY("",6))_" "
- +2 QUIT
- TOT ; Print Last Line
- +1 WRITE !!,X,?28
- FOR I=1:1:4
- WRITE $JUSTIFY($SELECT($PIECE(T2,"^",I):$PIECE(T2,"^",I),1:""),5)_" ",$SELECT($PIECE(T4,"^",I):$JUSTIFY($PIECE(T4,"^",I),7,0),1:$JUSTIFY("",7))_$JUSTIFY("",7)
- +2 WRITE ?108,$JUSTIFY($SELECT(CTN:CTN,1:""),5)_" ",$SELECT(NUM:$JUSTIFY(NUM,7,0),1:$JUSTIFY("",7))
- +3 KILL N,P,S,T2,T3,T4,T5
- QUIT
- HDR ; Print Heading for Encounter Category Summary
- +1 IF $Y'<(LIN-17)
- DO HDR^FHADRPT
- DO HDR2^FHADR3A
- +2 WRITE !!!!,"CLINICAL ENCOUNTER CATEGORY SUMMARY"
- +3 WRITE !!,?35,"1st Qtr",?55,"2nd Qtr",?76,"3rd Qtr",?95,"4th Qtr",?116,"YTD"
- +4 WRITE !?36,"Work",?56,"Work",?76,"Work",?96,"Work",?116,"Work"
- +5 WRITE !,"Clinical Categories",?30,"Tot Units % Tot Units % Tot Units % Tot Units % Tot Units %",!
- QUIT
