- 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
