source: FOIAVistA/trunk/r/DIETETICS-FH/FHASE2.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1FHASE2 ; 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
10Q1 ; 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
15QT W ! Q
16LST 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
26HDR ; 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="^"
29H1 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
32KIL G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.