| 1 | FHASE2 ; HISC/REL - Patient Encounter Inquiry ;4/27/93 10:08
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | S ALL=1 D ^FHDPA G:'DFN KIL
|
|---|
| 4 | I $P($G(^DPT(DFN,.35)),"^",1) W *7,!!?5," [ Patient has expired. ]"
|
|---|
| 5 | I '$D(^FHEN("AP",DFN)) W !!,"No Encounters on file for this patient." G FHASE2
|
|---|
| 6 | K %DT S %DT="AEPX",%DT("A")="Display Encounters Since: ",%DT(0)="-NOW" W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 KIL S DTE=Y
|
|---|
| 7 | K IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 8 | I $D(IO("Q")) S FHPGM="Q1^FHASE2",FHLST="DFN^PID^DTE" D EN2^FH G FHASE2
|
|---|
| 9 | U IO D Q1 D ^%ZISC K %ZIS,IOP G FHASE2
|
|---|
| 10 | Q1 ; Display Encounters
|
|---|
| 11 | S Y=$G(^DPT(DFN,0)),NAM=$P(Y,"^",1),N1=0,QT="^" D NOW^%DTC S DT=%\1,PG=0,N1=0,QT=""
|
|---|
| 12 | S DTP=DTE D DTP^FH S STRT=DTP D HDR
|
|---|
| 13 | F DTE=DTE-.000001:0 S DTE=$O(^FHEN("AP",DFN,DTE)) Q:DTE<1 F ASN=0:0 S ASN=$O(^FHEN("AP",DFN,DTE,ASN)) Q:ASN<1 D:(IOSL-$Y)<6 HDR G:QT="^" QT D LST S N1=N1+1
|
|---|
| 14 | I 'N1 W !!,"No Encounters recorded since ",STRT
|
|---|
| 15 | QT W ! Q
|
|---|
| 16 | LST S X0=$G(^FHEN(ASN,0)),X1=$G(^FHEN(ASN,"P",DFN,0))
|
|---|
| 17 | S DTP=$P(X0,"^",2) D DTP^FH W !!,$E(DTP,1,9)," " S Y=$P(X0,"^",4),Y=$P($G(^FH(115.6,+Y,0)),"^",1) W Y I $P(X0,"^",7)="F" W " (FU)"
|
|---|
| 18 | S Y=$P(X0,"^",3),Y=$P($G(^VA(200,+Y,0)),"^",1) W !,"Clinician: ",Y
|
|---|
| 19 | S Y=$P(X0,"^",5) I Y S Y=$P($G(^SC(+Y,0)),"^",1) I Y'="" W ?40,"Location: ",Y
|
|---|
| 20 | S Y=$P(X0,"^",11) I Y'="" W !?11,Y
|
|---|
| 21 | S Y=$P(X0,"^",9) W !?11,$S(Y="G":"Group",1:"Individual") S Y=$P(X1,"^",3) I Y W ", ",Y," collateral" W:Y>1 "s"
|
|---|
| 22 | S Y=$P(X1,"^",4) W:Y'="" !?11,Y
|
|---|
| 23 | S DTP=$P(X0,"^",14) I DTP D DTP^FH W !,"Entered : ",DTP S Y=$P(X0,"^",13),Y=$P($G(^VA(200,+Y,0)),"^",1) W:Y'="" " By: ",Y
|
|---|
| 24 | S DTP=$P(X0,"^",15) I DTP D DTP^FH W !,"Reviewed : ",DTP S Y=$P(X0,"^",16),Y=$P($G(^VA(200,+Y,0)),"^",1) W:Y'="" " By: ",Y
|
|---|
| 25 | Q
|
|---|
| 26 | HDR ; Print Header
|
|---|
| 27 | S QT="" G:IOST'?1"C".E H1
|
|---|
| 28 | I PG R !!,"Press RETURN to continue ",QT:DTIME S:'$T QT="^" Q:QT="^"
|
|---|
| 29 | H1 W:'($E(IOST,1,2)'="C-"&'PG) @IOF S DTP=DT D DTP^FH S DTP=$E(DTP,1,9),PG=PG+1
|
|---|
| 30 | W !,DTP,?13,"P A T I E N T D I E T E T I C E N C O U N T E R S",?73,"Page ",PG
|
|---|
| 31 | W !!,PID,?18,NAM Q
|
|---|
| 32 | KIL G KILL^XUSCLEAN
|
|---|
