FHASE2 ; HISC/REL - Patient Encounter Inquiry ;4/27/93 10:08
;;5.5;DIETETICS;;Jan 28, 2005
S ALL=1 D ^FHDPA G:'DFN KIL
I $P($G(^DPT(DFN,.35)),"^",1) W *7,!!?5," [ Patient has expired. ]"
I '$D(^FHEN("AP",DFN)) W !!,"No Encounters on file for this patient." G FHASE2
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
K IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="Q1^FHASE2",FHLST="DFN^PID^DTE" D EN2^FH G FHASE2
U IO D Q1 D ^%ZISC K %ZIS,IOP G FHASE2
Q1 ; Display Encounters
S Y=$G(^DPT(DFN,0)),NAM=$P(Y,"^",1),N1=0,QT="^" D NOW^%DTC S DT=%\1,PG=0,N1=0,QT=""
S DTP=DTE D DTP^FH S STRT=DTP D HDR
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
I 'N1 W !!,"No Encounters recorded since ",STRT
QT W ! Q
LST S X0=$G(^FHEN(ASN,0)),X1=$G(^FHEN(ASN,"P",DFN,0))
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)"
S Y=$P(X0,"^",3),Y=$P($G(^VA(200,+Y,0)),"^",1) W !,"Clinician: ",Y
S Y=$P(X0,"^",5) I Y S Y=$P($G(^SC(+Y,0)),"^",1) I Y'="" W ?40,"Location: ",Y
S Y=$P(X0,"^",11) I Y'="" W !?11,Y
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"
S Y=$P(X1,"^",4) W:Y'="" !?11,Y
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
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
Q
HDR ; Print Header
S QT="" G:IOST'?1"C".E H1
I PG R !!,"Press RETURN to continue ",QT:DTIME S:'$T QT="^" Q:QT="^"
H1 W:'($E(IOST,1,2)'="C-"&'PG) @IOF S DTP=DT D DTP^FH S DTP=$E(DTP,1,9),PG=PG+1
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
W !!,PID,?18,NAM Q
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHASE2 2061 printed Dec 13, 2024@01:46:46 Page 2
FHASE2 ; HISC/REL - Patient Encounter Inquiry ;4/27/93 10:08
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 SET ALL=1
DO ^FHDPA
if 'DFN
GOTO KIL
+3 IF $PIECE($GET(^DPT(DFN,.35)),"^",1)
WRITE *7,!!?5," [ Patient has expired. ]"
+4 IF '$DATA(^FHEN("AP",DFN))
WRITE !!,"No Encounters on file for this patient."
GOTO FHASE2
+5 KILL %DT
SET %DT="AEPX"
SET %DT("A")="Display Encounters Since: "
SET %DT(0)="-NOW"
WRITE !
DO ^%DT
KILL %DT
if $DATA(DTOUT)
SET Y=0
if Y<1
GOTO KIL
SET DTE=Y
+6 KILL IOP
SET %ZIS="MQ"
SET %ZIS("B")="HOME"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+7 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHASE2"
SET FHLST="DFN^PID^DTE"
DO EN2^FH
GOTO FHASE2
+8 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO FHASE2
Q1 ; Display Encounters
+1 SET Y=$GET(^DPT(DFN,0))
SET NAM=$PIECE(Y,"^",1)
SET N1=0
SET QT="^"
DO NOW^%DTC
SET DT=%\1
SET PG=0
SET N1=0
SET QT=""
+2 SET DTP=DTE
DO DTP^FH
SET STRT=DTP
DO HDR
+3 FOR DTE=DTE-.000001:0
SET DTE=$ORDER(^FHEN("AP",DFN,DTE))
if DTE<1
QUIT
FOR ASN=0:0
SET ASN=$ORDER(^FHEN("AP",DFN,DTE,ASN))
if ASN<1
QUIT
if (IOSL-$Y)<6
DO HDR
if QT="^"
GOTO QT
DO LST
SET N1=N1+1
+4 IF 'N1
WRITE !!,"No Encounters recorded since ",STRT
QT WRITE !
QUIT
LST SET X0=$GET(^FHEN(ASN,0))
SET X1=$GET(^FHEN(ASN,"P",DFN,0))
+1 SET DTP=$PIECE(X0,"^",2)
DO DTP^FH
WRITE !!,$EXTRACT(DTP,1,9)," "
SET Y=$PIECE(X0,"^",4)
SET Y=$PIECE($GET(^FH(115.6,+Y,0)),"^",1)
WRITE Y
IF $PIECE(X0,"^",7)="F"
WRITE " (FU)"
+2 SET Y=$PIECE(X0,"^",3)
SET Y=$PIECE($GET(^VA(200,+Y,0)),"^",1)
WRITE !,"Clinician: ",Y
+3 SET Y=$PIECE(X0,"^",5)
IF Y
SET Y=$PIECE($GET(^SC(+Y,0)),"^",1)
IF Y'=""
WRITE ?40,"Location: ",Y
+4 SET Y=$PIECE(X0,"^",11)
IF Y'=""
WRITE !?11,Y
+5 SET Y=$PIECE(X0,"^",9)
WRITE !?11,$SELECT(Y="G":"Group",1:"Individual")
SET Y=$PIECE(X1,"^",3)
IF Y
WRITE ", ",Y," collateral"
if Y>1
WRITE "s"
+6 SET Y=$PIECE(X1,"^",4)
if Y'=""
WRITE !?11,Y
+7 SET DTP=$PIECE(X0,"^",14)
IF DTP
DO DTP^FH
WRITE !,"Entered : ",DTP
SET Y=$PIECE(X0,"^",13)
SET Y=$PIECE($GET(^VA(200,+Y,0)),"^",1)
if Y'=""
WRITE " By: ",Y
+8 SET DTP=$PIECE(X0,"^",15)
IF DTP
DO DTP^FH
WRITE !,"Reviewed : ",DTP
SET Y=$PIECE(X0,"^",16)
SET Y=$PIECE($GET(^VA(200,+Y,0)),"^",1)
if Y'=""
WRITE " By: ",Y
+9 QUIT
HDR ; Print Header
+1 SET QT=""
if IOST'?1"C".E
GOTO H1
+2 IF PG
READ !!,"Press RETURN to continue ",QT:DTIME
if '$TEST
SET QT="^"
if QT="^"
QUIT
H1 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
SET DTP=DT
DO DTP^FH
SET DTP=$EXTRACT(DTP,1,9)
SET PG=PG+1
+1 WRITE !,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
+2 WRITE !!,PID,?18,NAM
QUIT
KIL GOTO KILL^XUSCLEAN
