FHCTF1 ; HISC/REL/NCA - Display Tickler File ;4/6/01 08:43
;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
;patch 4 - changed the output by clinician order if ALL is selected.
E0 W !!,"Select CLINICIAN (or ALL): ",$P($G(^VA(200,DUZ,0)),"^",1)," // " R X:DTIME G:'$T!(X="^") KIL
I X="" S FHDUZ=DUZ G DISP
D TR^FH I X="ALL" S FHDUZ=0 G DISP
K DIC S DIC="^VA(200,",DIC(0)="AQEM",DIC("A")="Select CLINICIAN: ",DIC("B")=$P($G(^VA(200,DUZ,0)),"^",1) W ! D ^DIC K DIC G KIL:"^"[X!$D(DTOUT),E0:Y<1 S FHDUZ=+Y
DISP ; Display Tickler File
E1 S %DT="AEFX",%DT("A")="Through Date: ",%DT("B")="TODAY" W ! D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,E1:Y<1 S EDT=+Y+.3
E2 W ! K IOP,%ZIS S %ZIS("A")="Select LIST PRINTER: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="Q0^FHCTF1",FHLST="EDT^FHDUZ" D EN2^FH G KIL
U IO D Q0 D ^%ZISC K %ZIS,IOP G KIL
Q0 ; Process Displaying Tickler File Entries
D ^FHCTF4 S (CNT,PG)=0,YN="" G:FHDUZ Q1
;F FHDUZ=0:0 S FHDUZ=$O(^FH(119,FHDUZ)) Q:FHDUZ<1 I $O(^FH(119,FHDUZ,"I",EDT+1),-1) D Q1 Q:YN="^"
K FHTCK S FHDTP=""
F FHDUZ=0:0 S FHDUZ=$O(^FH(119,FHDUZ)) Q:FHDUZ<1 I $O(^FH(119,FHDUZ,"I",EDT+1),-1) S FHTCK($P(^VA(200,FHDUZ,0),"^",1),FHDUZ)=""
S FHDUZNM="" F S FHDUZNM=$O(FHTCK(FHDUZNM)) Q:FHDUZNM="" S FHDUZ=$O(FHTCK(FHDUZNM,0)) D:FHDUZ Q1 Q:YN="^"
Q
Q1 D HDR K ^TMP($J,"FH")
F K=0:0 S K=$O(^FH(119,FHDUZ,"I",K)) Q:K<1!(K>EDT) S FHTF=^(K,0) S FHDFN=$P(FHTF,U,4) S:'FHDFN ^TMP($J,"FH","1PERSONALIZED",K)="" I FHDFN,$D(^DPT(FHDFN,0)) D
.S ^TMP($J,"FH",$P(^DPT(FHDFN,0),U,1))=FHDFN
.S ^TMP($J,"FH",$P(^DPT(FHDFN,0),U,1),K)=""
G:'$D(^TMP($J,"FH")) QT2
S FHI=""
F S FHI=$O(^TMP($J,"FH",FHI)) Q:(FHI="")!(YN="^") D PT1 F FHJ=0:0 S FHJ=$O(^TMP($J,"FH",FHI,FHJ)) Q:(FHJ'>0)!(YN="^") D D2
QT2 I 'CNT W !!,"No Tickler File Entries"
W ! Q
;
D2 S FHTF=^FH(119,FHDUZ,"I",FHJ,0) D:$Y>(IOSL-5) HDR Q:YN["^"
S DTP=$P(FHTF,"^",1),TYP=$P(FHTF,"^",2),X=$P(FHTF,"^",3),DFN=$P(FHTF,"^",4),ADM=$P(FHTF,"^",5),FHOR=$P(FHTF,"^",6)
D DTP
W !
I FHDTP'=DTP W DTP S FHDTP=DTP
W ?18,$S(TYP="C":"Consult",TYP="S":"SF Review",TYP="D":"Diet Review",TYP="X":"Personal",TYP="T":"Tubefeed",TYP="N":"Status",1:""),": ",X
;I DFN W !?18,$P($G(^DPT(DFN,0)),"^",1)," (",$E($P($G(^(0)),"^",9),6,9),") "
I DFN S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
I DFN S FHWRD=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8) W " ",$P($G(^FH(119.6,+FHWRD,0)),"^",1)," ",$P($G(^DPT(DFN,.101)),"^",1)
S CNT=CNT+1 Q
;
PT1 ;print patient info.
S FHDTP=""
W !
S DFN=$G(^TMP($J,"FH",FHI)) I 'DFN W !?18,"** PERSONALIZED TICKLER **" Q
W:DFN !?18,"** ",$P($G(^DPT(DFN,0)),"^",1)," (",$E($P($G(^(0)),"^",9),6,9),") **"
Q
;
DTP ; Printable Date/Time
S %=DTP,DTP=$J(+$E(DTP,6,7),2)_"-"_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$E(DTP,4,5))_"-"_$E(DTP,2,3)
S:%#1 %=+$E(%_"0",9,10)_"^"_$E(%_"000",11,12),DTP=DTP_$J($S(%>12:%-12,1:+%),3)_":"_$P(%,"^",2)_$S(%<12:"am",%<24:"pm",1:"m") K % Q
HDR ; Display Header
I PG,IOST?1"C-".E R !!,"Press RETURN to continue or ""^"" to exit. ",YN:DTIME S:'$T!(YN["^") YN="^" Q:YN="^" I "^"'[YN W !,"Enter Return or ""^""." G HDR
W:'($E(IOST,1,2)'="C-"&'PG) @IOF
S PG=PG+1,DTP=NOW D DTP^FH W !,DTP,?28,"T I C K L E R F I L E",?73,"Page ",PG
W !,$P(^VA(200,FHDUZ,0),"^",1) S DTP=EDT\1 D DTP^FH W ?64,"Thru: ",DTP
S $P(LN,"-",80)="" W !,LN,! Q
KIL K ^TMP($J,"FH") G KILL^XUSCLEAN
FHCTF1 ; HISC/REL/NCA - Display Tickler File ;4/6/01 08:43
+1 ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
+2 ;patch 4 - changed the output by clinician order if ALL is selected.
E0 WRITE !!,"Select CLINICIAN (or ALL): ",$PIECE($GET(^VA(200,DUZ,0)),"^",1)," // "
READ X:DTIME
IF '$TEST!(X="^")
GOTO KIL
+1 IF X=""
SET FHDUZ=DUZ
GOTO DISP
+2 DO TR^FH
IF X="ALL"
SET FHDUZ=0
GOTO DISP
+3 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="AQEM"
SET DIC("A")="Select CLINICIAN: "
SET DIC("B")=$PIECE($GET(^VA(200,DUZ,0)),"^",1)
WRITE !
DO ^DIC
KILL DIC
IF "^"[X!$DATA(DTOUT)
GOTO KIL
IF Y<1
GOTO E0
SET FHDUZ=+Y
DISP ; Display Tickler File
E1 SET %DT="AEFX"
SET %DT("A")="Through Date: "
SET %DT("B")="TODAY"
WRITE !
DO ^%DT
IF $DATA(DTOUT)
SET X="^"
IF U[X
GOTO KIL
IF Y<1
GOTO E1
SET EDT=+Y+.3
E2 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select LIST PRINTER: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
IF POP
GOTO KIL
+1 IF $DATA(IO("Q"))
SET FHPGM="Q0^FHCTF1"
SET FHLST="EDT^FHDUZ"
DO EN2^FH
GOTO KIL
+2 USE IO
DO Q0
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
Q0 ; Process Displaying Tickler File Entries
+1 DO ^FHCTF4
SET (CNT,PG)=0
SET YN=""
IF FHDUZ
GOTO Q1
+2 ;F FHDUZ=0:0 S FHDUZ=$O(^FH(119,FHDUZ)) Q:FHDUZ<1 I $O(^FH(119,FHDUZ,"I",EDT+1),-1) D Q1 Q:YN="^"
+3 KILL FHTCK
SET FHDTP=""
+4 FOR FHDUZ=0:0
SET FHDUZ=$ORDER(^FH(119,FHDUZ))
IF FHDUZ<1
QUIT
IF $ORDER(^FH(119,FHDUZ,"I",EDT+1),-1)
SET FHTCK($PIECE(^VA(200,FHDUZ,0),"^",1),FHDUZ)=""
+5 SET FHDUZNM=""
FOR
SET FHDUZNM=$ORDER(FHTCK(FHDUZNM))
IF FHDUZNM=""
QUIT
SET FHDUZ=$ORDER(FHTCK(FHDUZNM,0))
IF FHDUZ
DO Q1
IF YN="^"
QUIT
+6 QUIT
Q1 DO HDR
KILL ^TMP($JOB,"FH")
+1 FOR K=0:0
SET K=$ORDER(^FH(119,FHDUZ,"I",K))
IF K<1!(K>EDT)
QUIT
SET FHTF=^(K,0)
SET FHDFN=$PIECE(FHTF,U,4)
IF 'FHDFN
SET ^TMP($JOB,"FH","1PERSONALIZED",K)=""
IF FHDFN
IF $DATA(^DPT(FHDFN,0))
Begin DoDot:1
+2 SET ^TMP($JOB,"FH",$PIECE(^DPT(FHDFN,0),U,1))=FHDFN
+3 SET ^TMP($JOB,"FH",$PIECE(^DPT(FHDFN,0),U,1),K)=""
End DoDot:1
+4 IF '$DATA(^TMP($JOB,"FH"))
GOTO QT2
+5 SET FHI=""
+6 FOR
SET FHI=$ORDER(^TMP($JOB,"FH",FHI))
IF (FHI="")!(YN="^")
QUIT
DO PT1
FOR FHJ=0:0
SET FHJ=$ORDER(^TMP($JOB,"FH",FHI,FHJ))
IF (FHJ'>0)!(YN="^")
QUIT
DO D2
QT2 IF 'CNT
WRITE !!,"No Tickler File Entries"
+1 WRITE !
QUIT
+2 ;
D2 SET FHTF=^FH(119,FHDUZ,"I",FHJ,0)
IF $Y>(IOSL-5)
DO HDR
IF YN["^"
QUIT
+1 SET DTP=$PIECE(FHTF,"^",1)
SET TYP=$PIECE(FHTF,"^",2)
SET X=$PIECE(FHTF,"^",3)
SET DFN=$PIECE(FHTF,"^",4)
SET ADM=$PIECE(FHTF,"^",5)
SET FHOR=$PIECE(FHTF,"^",6)
+2 DO DTP
+3 WRITE !
+4 IF FHDTP'=DTP
WRITE DTP
SET FHDTP=DTP
+5 WRITE ?18,$SELECT(TYP="C":"Consult",TYP="S":"SF Review",TYP="D":"Diet Review",TYP="X":"Personal",TYP="T":"Tubefeed",TYP="N":"Status",1:""),": ",X
+6 ;I DFN W !?18,$P($G(^DPT(DFN,0)),"^",1)," (",$E($P($G(^(0)),"^",9),6,9),") "
+7 IF DFN
SET FHZ115="P"_DFN
DO CHECK^FHOMDPA
IF FHDFN=""
QUIT
+8 IF DFN
SET FHWRD=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",8)
WRITE " ",$PIECE($GET(^FH(119.6,+FHWRD,0)),"^",1)," ",$PIECE($GET(^DPT(DFN,.101)),"^",1)
+9 SET CNT=CNT+1
QUIT
+10 ;
PT1 ;print patient info.
+1 SET FHDTP=""
+2 WRITE !
+3 SET DFN=$GET(^TMP($JOB,"FH",FHI))
IF 'DFN
WRITE !?18,"** PERSONALIZED TICKLER **"
QUIT
+4 IF DFN
WRITE !?18,"** ",$PIECE($GET(^DPT(DFN,0)),"^",1)," (",$EXTRACT($PIECE($GET(^(0)),"^",9),6,9),") **"
+5 QUIT
+6 ;
DTP ; Printable Date/Time
+1 SET %=DTP
SET DTP=$JUSTIFY(+$EXTRACT(DTP,6,7),2)_"-"_$PIECE("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$EXTRACT(DTP,4,5))_"-"_$EXTRACT(DTP,2,3)
+2 IF %#1
SET %=+$EXTRACT(%_"0",9,10)_"^"_$EXTRACT(%_"000",11,12)
SET DTP=DTP_$JUSTIFY($SELECT(%>12:%-12,1:+%),3)_":"_$PIECE(%,"^",2)_$SELECT(%<12:"am",%<24:"pm",1:"m")
KILL %
QUIT
HDR ; Display Header
+1 IF PG
IF IOST?1"C-".E
READ !!,"Press RETURN to continue or ""^"" to exit. ",YN:DTIME
IF '$TEST!(YN["^")
SET YN="^"
IF YN="^"
QUIT
IF "^"'[YN
WRITE !,"Enter Return or ""^""."
GOTO HDR
+2 IF '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
+3 SET PG=PG+1
SET DTP=NOW
DO DTP^FH
WRITE !,DTP,?28,"T I C K L E R F I L E",?73,"Page ",PG
+4 WRITE !,$PIECE(^VA(200,FHDUZ,0),"^",1)
SET DTP=EDT\1
DO DTP^FH
WRITE ?64,"Thru: ",DTP
+5 SET $PIECE(LN,"-",80)=""
WRITE !,LN,!
QUIT
KIL KILL ^TMP($JOB,"FH")
GOTO KILL^XUSCLEAN
