- 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
- 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
