Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHCTF4

FHCTF4.m

Go to the documentation of this file.
  1. FHCTF4 ; HISC/REL/NCA - Check Ward Patients for a Clinician ;3/8/01 13:13
  1. ;;5.5;DIETETICS;**20**;Jan 28, 2005;Build 7
  1. ;FH*5.5*20 adds support for CLINICIAN(S) field (#112)
  1. D NOW^%DTC S NOW=% D CLN
  1. F WRD=0:0 S WRD=$O(^FH(119.6,WRD)) Q:WRD<1 D
  1. . F FHCLN=0:0 S FHCLN=$O(^FH(119.6,WRD,2,FHCLN)) Q:FHCLN<1 D
  1. . . I ^FH(119.6,WRD,2,FHCLN,0)=FHDUZ!('FHDUZ) D CHK
  1. Q
  1. CHK D DAT F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",WRD,FHDFN)) Q:FHDFN<1 S ADM=$G(^FHPT("AW",WRD,FHDFN)) D PAT
  1. Q
  1. CLN ; Clean up ticker file
  1. F K=0:0 S K=$O(^FH(119,FHDUZ,"I",K)) Q:K<1 S X=^(K,0) D C0
  1. Q
  1. C0 ;
  1. S DFN=$P(X,"^",4),A0="",FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
  1. G:'DFN C1 S ADM=$P(X,"^",5) G:'ADM C1
  1. S W1=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8) I W1="" G KIL
  1. S Y=$G(^FHPT("AW",W1,FHDFN)) I ADM'=Y G KIL
  1. S (Y,Y1)=0
  1. F Y=0:0 S Y=$O(^FH(119.6,+W1,2,Y)) Q:Y<1 D
  1. . I ^FH(119.6,+W1,2,Y,0)="" S Y1=0 Q
  1. . I ^FH(119.6,+W1,2,Y,0)=FHDUZ S Y=-1,Y1=0 Q
  1. . S Y1=1
  1. I Y1 K Y1 G KIL
  1. K Y1
  1. S A0=$G(^FHPT(FHDFN,"A",ADM,0))
  1. C1 S TYP=$P(X,"^",2) G C2:TYP="C",C3:TYP="S",C4:TYP="D",C5:TYP="X",C6:TYP="T",C7:TYP="N" Q
  1. C2 S FHDR=$P(X,"^",6),Y=^FHPT(FHDFN,"A",ADM,"DR",FHDR,0) I $P(Y,"^",8)'="A"!($P(Y,"^",5)'=FHDUZ) D KIL
  1. Q
  1. C3 D:$P(X,"^",6)'=$P(A0,"^",7) KIL Q
  1. C4 D:$P(X,"^",6)'=$P(A0,"^",2) KIL Q
  1. C5 D:+X<NOW KIL Q
  1. C6 D:$P(X,"^",6)'=$P(A0,"^",4) KIL Q
  1. C7 S Y=$O(^FHPT(FHDFN,"S",0)) D:Y<$P(X,"^",6) KIL Q
  1. KIL K ^FH(119,FHDUZ,"I",K)
  1. ;K ^FH(119,FHDUZ,"I","C",PT,DT)
  1. Q
  1. PAT ; Check Patient
  1. D PATNAME^FHOMUTL I DFN="" Q
  1. S A0=$G(^FHPT(FHDFN,"A",ADM,0)),FHORD=$P(A0,"^",2) I FHORD S X1=$P(A0,"^",3) G P1
  1. S LST=$P(A0,"^",1),FHLD="X" S:'LST LST=+D("NP") G P2
  1. P1 S X=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),FHLD=$P(X,"^",7),PD=$P(X,"^",13),LST=$P(X,"^",16) I 'LST S LST=$P(X,"^",9)
  1. G P4:FHLD="P",P2:'PD S LR=$G(D("D",PD)) G P4:'LR,P4:LST>LR
  1. S FHTF="D^"_$P(^FH(116.2,PD,0),"^",1)_"^"_DFN_"^"_ADM_"^"_FHORD D FIL
  1. G P4
  1. P2 ; Check NPO/No Order
  1. G:$P(A0,"^",4) P4 S LR=$G(D("NP")) G P4:'LR,P4:LST>LR
  1. S FHTF="D^"_$S(FHLD="P":"NPO",1:"No Order")_" > "_$P(LR,"^",2)_" days^"_DFN_"^"_ADM_"^"_FHORD D FIL
  1. P4 ; Check Supplemental Feeding
  1. S NO=$P(A0,"^",7) G:'NO P5 S LR=$G(D("SF")) G:'LR P5
  1. S LST=$P(^FHPT(FHDFN,"A",ADM,"SF",NO,0),"^",30) I 'LST S LST=$P(^(0),"^",2)
  1. G:LST>LR P5 S Y=$P(^FHPT(FHDFN,"A",ADM,"SF",NO,0),"^",4),Y=$P($G(^FH(118.1,+Y,0)),"^",1)
  1. S FHTF="S^"_Y_"^"_DFN_"^"_ADM_"^"_NO D FIL
  1. P5 ; Check Tubefeeding
  1. S TF=$P(A0,"^",4) G:'TF P6 S LR=$G(D("TF")) G:'LR P6
  1. S LST=$P(^FHPT(FHDFN,"A",ADM,"TF",TF,0),"^",15) I 'LST S LST=$P(^(0),"^",1)
  1. G:LST>LR P6
  1. S Y="" F TF2=0:0 S TF2=$O(^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2)) Q:TF2<1 S XX=^(TF2,0) S:Y'="" Y=Y_", " S Y=Y_$P($G(^FH(118.2,$P(XX,"^",1),0)),"^",1)
  1. S FHTF="T^"_Y_"^"_DFN_"^"_ADM_"^"_TF D FIL
  1. P6 ; Check Status
  1. S F1=$O(^FHPT(FHDFN,"S",0)) G:'F1 P7 S A1=^FHPT(FHDFN,"S",F1,0) I $P(A1,"^",1)<$P(A0,"^",1) G P7
  1. S S1=$P(A1,"^",2),LR=$G(D("S",S1)) G:'LR P8
  1. S LST=$P(A1,"^",4) I 'LST S LST=$P(A1,"^",1)
  1. G:LST>LR P8 S Y=$P(^FH(115.4,S1,0),"^",2)
  1. S FHTF="N^"_Y_"^"_DFN_"^"_ADM_"^"_F1 D FIL G P8
  1. P7 S LR=$G(D("NS")) G:'LR P8 S LST=$P(A0,"^",1) G P8:LST>LR,P8:'LST
  1. S FHTF="N^No Admission Status^"_DFN_"^"_ADM_"^"_(9999999-LST) D FIL G P8
  1. P8 Q
  1. FIL ; File entry
  1. F L=0:0 S L=$O(^FH(119,FHDUZ,"I",L)) Q:L<1 I $P(^(L,0),"^",2,6)=FHTF S FHTF="" Q
  1. Q:FHTF="" S X1=LST,X2=$P(LR,"^",2) D C^%DTC S FHTF=X_"^"_FHTF D FILE^FHCTF2 Q
  1. DAT ; Get Review Dates
  1. K D,T S FHPAR=$G(^FH(119.6,WRD,0)),L=10
  1. F K="NP","TF","SF","NS" S L=L+1,Z=$P(FHPAR,"^",L),D(K)="" I Z D D1 S D(K)=X_"^"_Z
  1. F K=1:1:4 S Z=$P(FHPAR,"^",K+19) I Z D D1 S D("S",K)=X_"^"_Z
  1. F K=0:0 S K=$O(^FH(116.2,K)) Q:K<1 S Z=$P(^(K,0),"^",8) I Z D D1 S D("D",K)=X_"^"_Z
  1. K T Q
  1. D1 I $D(T(Z)) S X=T(Z) Q
  1. S X1=NOW,X2=-Z D C^%DTC S T(Z)=X Q