FHCTF5 ; HIOFO/REL/FAI - Check Inpatients for Monitors ;Jan 04, 2023@08:31:34
;;5.5;DIETETICS;**4,8,20,55**;Jan 28, 2005;Build 7
;3/14/07 - patch 8 adds the nutrition assessment alert.
;12/29/09 - patch 20 adds support for CLINICIAN(S) field (#112) in NUTRITION
; LOCATION file (#119.6) and bug fixes, refer to patch documentation
; for details.
;
D NOW^%DTC S NOW=% D CLR
S FHEDT=$P(NOW,".")
F WRD=0:0 S WRD=$O(^FH(119.6,WRD)) Q:WRD<1 F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",WRD,FHDFN)) Q:FHDFN'>0 S ADM=$G(^FHPT("AW",WRD,FHDFN)) D PAT
D P5
K %,A1,A2,ADM,BMI,CLR,DA,DD,DFN,DIC,DTE,FHDUZ,FHOR,FHORD,FHTF
K GMRVSTR,HT,L,LST,MONIFN,MONTX,N,NOW,PX,STOP,TF,WRD,WT,X,X0,Y
K I,FHTMO,FHTFLG,FHTFLG1,FHTFLG2,FHEDT,FHTICK,FHTDFN,FHTDT1,FHWTDT,FHHTDT,WARD,FHGMDT
K A,A0,AGE,BID,DEAD,FDA,FHAGE,FHBID,FHCLIN,FHDFN,FHI,FHI115,FHJ,FHJDAT,FHDFN
K FHPTNM,FHPCZN,FHSEX,FHSSN,FHHDAT,FILE,HTM,IEN,IEN200,NAM,PID,SEX
Q
PAT ; Check a patient
D PATNAME^FHOMUTL I DFN="" Q
S Y=^DPT(DFN,0),NAM=$P(Y,"^",1),SEX=$P(Y,"^",2),DOB=$P(Y,"^",3)
S AGE="" I DOB'="" S AGE=$E(NOW,1,3)-$E(DOB,1,3)-($E(NOW,4,7)<$E(DOB,4,7))
S DEAD=$P($G(^DPT(DFN,.35)),"^",1) Q:DEAD'=""
D ALRT^FHASM2A ;creates alert for nutrition assessment(follow-up dt & food/drug interaction.
;
P0 ; Calculate BMI
S GMRVSTR="WT" D EN6^GMRVUTL S WT=$P(X,"^",8),FHWTDT=$P(X,"^",1)
S GMRVSTR="HT" D EN6^GMRVUTL S HT=$P(X,"^",8),FHHTDT=$P(X,"^",1)
S FHGMDT=$S(FHWTDT>FHHTDT:FHWTDT,FHHTDT>FHWTDT:FHHTDT,1:FHWTDT)
S BMI="" I WT,HT S A2=HT*.0254,BMI=+$J(WT/2.2/(A2*A2),0,1)
I $G(BMI)=""!($G(BMI)'<18.5) G P1
S MONTX="Monitor: BMI < 18.5",DTE=NOW
S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1) I 'N,(FHGMDT>(FHEDT-7)) D FIL G P1
I 'N G P1
; Check if been 30 days
S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
S X=$$FMDIFF^XLFDT(DTE,LST) I (X>30) D FIL
P1 ; Check for current Tubefeeding
S TF=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",4) I 'TF G P2
S MONTX="Monitor: On Tubefeeding",DTE=NOW
S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1) I 'N D FIL G P2
; Check if been 7 days
S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
S X=$$FMDIFF^XLFDT(DTE,LST) I X>7 D FIL
P2 ; Check for Hyperals
S MONTX="",DTE=NOW
D PSS435^PSS55(DFN,,"FHIV") F DA=0:0 S DA=$O(^TMP($J,"FHIV",DA)) Q:DA<1 D
.S (X0,HTM)=$P($G(^TMP($J,"FHIV",DA,.02)),"^",2) I X0>NOW Q
.S MONTX="Monitor: On Hyperals" D FIL Q
;
P3 ; Check for Serum Albumin
S MONTX="",PX=6 D LAB^FHASM4 I $D(^TMP($J,"LRTST")) D
.F L=0:0 S L=$O(^TMP($J,"LRTST",L)) Q:L<1 S Y=$TR($P(^(L),"^",6)," ","") I Y'?1A.E,Y<2.8 S MONTX="Monitor: Albumin < 2.8",DTE=$P(^(L),"^",7)
I MONTX="" G P4
S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
;process new Albumin if old test date is within 7 days.
I 'N S X=$$FMDIFF^XLFDT(NOW,DTE) I X<8 D FIL G P4
I 'N G P4
; Check if same test
S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2) I DTE>LST D FIL
;
P4 ; Check for NPO+Clr Liq > 3 days
S A1=NOW,A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1),-1) ;Get last diet sequence record
I 'A1 Q ;Quit if none found
S FHORD=$P($G(^FHPT(FHDFN,"A",ADM,"AC",A1,0)),"^",2) ;Get diet order number
I 'FHORD Q ;Quit if none found
S FHOR=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)) ;Get diet order
;Check if diet order is NPO or clear liquid, if not set DTE to null
S DTE=$S($P(FHOR,"^",7)="N":A1,$P(FHOR,"^",2)=CLR:A1,1:"")
I DTE'="" D ;If DTE is not null process record
. I DTE'<NOW Q ;Quit if pending NPO+Clr Liq order
. ;Check if NPO+Clr Liq order is less than 3 days old, if true quit
. S X=$$FMDIFF^XLFDT(NOW,DTE) Q:X<3
. ;Prepare to file NPO+Clr Liq monitor
. S MONTX="Monitor: NPO+Clr Liq > 3 days",DTE=NOW
. ;Get NPO+Clr Liq monitor record for this patient, this admission
. S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
. ;If NPO+Clr Liq monitor does not exist for this patient, this admission, file monitor
. I 'N D FIL Q
. ;Get file date of last NPO/CLR LIQ monitor
. S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
. ;Check if monitor record is older than 3 days, if true file monitor
. S X=$$FMDIFF^XLFDT(NOW,LST) I X>3 D FIL
Q
P5 ;clear personalized tickler and quit
F FHI=0:0 S FHI=$O(^FH(119,FHI)) Q:FHI'>0 F FHJ=0:0 S FHJ=$O(^FH(119,FHI,"I",FHJ)) Q:FHJ'>0 D
.S FHJDAT=$G(^FH(119,FHI,"I",FHJ,0))
.Q:$P(FHJDAT,U,2)'="X"
.I $P(FHJDAT,U,1)<NOW K ^FH(119,FHI,"I",FHJ)
Q
CLR ; Find Clear Liquid
S CLR=$O(^FH(111,"B","CLEAR LIQUID",0)) Q:CLR
S CLR=$O(^FH(111,"C","CLEAR LIQUID",0)) Q:CLR
S CLR=$O(^FH(111,"C","CLR LIQ",0)) Q:CLR
S CLR=$O(^FH(111,"C","CL",0)) Q:CLR
Q
FIL ; File Monitor
D PATNAME^FHOMUTL
;Check monitor ticklers on file
S (FHTFLG1,FHTFLG2)=0
;Process dietitians for the ward
F A=0:0 S A=$O(^FH(119.6,WRD,2,A)) Q:A'>0 D
. S FHDUZ=$P($G(^FH(119.6,WRD,2,A,0)),U,1),FHTFLG=0,FHTFLG1=FHTFLG1+1
. ;If FHDUZ is null for any reason go to next dietitian
. I FHDUZ="" S FHTFLG2=FHTFLG2+1 Q
. ;Process the ticklers for the dietitian
. F I=0:0 S I=$O(^FH(119,FHDUZ,"I",I)) Q:I'>0 D
. . S FHTDT1=$P(I,".",1)
. . S FHTICK=^FH(119,FHDUZ,"I",I,0)
. . S FHTMO=$P(FHTICK,"^",3)
. . S FHTDFN=$P(FHTICK,"^",4)
. . I (FHTMO=MONTX),(FHTDFN=DFN),(FHTDT1=FHEDT) S FHTFLG=1,FHTFLG2=FHTFLG2+1
. Q:FHTFLG ;Only one monitor for the same day, same clinicin and same patient
;Quit if all clinicians for a ward meet the conditions of one monitor for the same day, same clinician, same patient
I FHTFLG1=FHTFLG2 Q
;File montior for patient
L +^FHPT(FHDFN,"A",ADM,"MO",0):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
I '$D(^FHPT(FHDFN,"A",ADM,"MO",0)) S ^FHPT(FHDFN,"A",ADM,"MO",0)="^115.11^^"
L -^FHPT(FHDFN,"A",ADM,"MO",0)
K DIC,DD,DO,DINUM S DIC="^FHPT(FHDFN,""A"",ADM,""MO"",",DIC(0)="L",DA(1)=ADM,DA(2)=FHDFN,DLAYGO=115,X=MONTX D FILE^DICN K DIC,DLAYGO
Q:Y<1 S MONIFN=+Y
S $P(^FHPT(FHDFN,"A",ADM,"MO",MONIFN,0),"^",2)=DTE,^FHPT(FHDFN,"A",ADM,"MO","AC",DTE,MONIFN)=""
;Creating tickler file entries for clinicians
F A=0:0 S A=$O(^FH(119.6,WRD,2,A)) Q:A'>0 D
. S FHDUZ=$P($G(^FH(119.6,WRD,2,A,0)),U,1)
. ;If FHDUZ is null for any reason go to next clinician
. I FHDUZ="" Q
. ;Build tickler record
. S FHTF=DTE_"^M^"_MONTX_"^"_DFN_"^"_ADM_"^"_MONIFN
. D FILE^FHCTF2 ;File tickler record
;Check to determine if monitor tickler alerts are enabled.
;If enabled, send tickler alert
;PATCH 55 set a different code for each alert
I (MONTX["BMI"),($P($G(^FH(119.6,WRD,1)),"^",5)="Y") S FHCODE=3 D ALRT Q
I (MONTX["Tubefeed"),($P($G(^FH(119.6,WRD,1)),"^",6)="Y") S FHCODE=4 D ALRT Q
I (MONTX["Hyperals"),($P($G(^FH(119.6,WRD,1)),"^",7)="Y") S FHCODE=5 D ALRT Q
I (MONTX["Albumin"),($P($G(^FH(119.6,WRD,1)),"^",8)="Y") S FHCODE=6 D ALRT Q
I (MONTX["NPO+Clr"),($P($G(^FH(119.6,WRD,1)),"^",9)="Y") S FHCODE=7 D ALRT Q
Q
;
ALRT ;Send alerts
F A=0:0 S A=$O(^FH(119.6,WRD,2,A)) Q:A'>0 D
. K XQA,XQAID,XQAMSG,XQAOPT,XQAROU
. S FHDUZ=$P($G(^FH(119.6,WRD,2,A,0)),U,1)
. I FHDUZ="" Q
. S FHCLIN=$P($$GET1^DIQ(200,FHDUZ_",",.01),",")
. ;S XQAID="FH,"_$J_","_$TR($H,",")
. S XQAID="FH,"_DFN_","_FHCODE ;p55
. S XQA(FHDUZ)=""
. ;S XQAOPT="FHCTF2" p55
. S XQAMSG=$E($P(FHPTNM,","),1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
. S XQAMSG=XQAMSG_" "_MONTX_" "_$E(DTE,4,5)_"/"_$E(DTE,6,7)_"/"_$E(DTE,2,3)_" Clinician: "_$G(FHCLIN)
. D SETUP^XQALERT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHCTF5 7372 printed Apr 09, 2024@20:59:02 Page 2
FHCTF5 ; HIOFO/REL/FAI - Check Inpatients for Monitors ;Jan 04, 2023@08:31:34
+1 ;;5.5;DIETETICS;**4,8,20,55**;Jan 28, 2005;Build 7
+2 ;3/14/07 - patch 8 adds the nutrition assessment alert.
+3 ;12/29/09 - patch 20 adds support for CLINICIAN(S) field (#112) in NUTRITION
+4 ; LOCATION file (#119.6) and bug fixes, refer to patch documentation
+5 ; for details.
+6 ;
+7 DO NOW^%DTC
SET NOW=%
DO CLR
+8 SET FHEDT=$PIECE(NOW,".")
+9 FOR WRD=0:0
SET WRD=$ORDER(^FH(119.6,WRD))
if WRD<1
QUIT
FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("AW",WRD,FHDFN))
if FHDFN'>0
QUIT
SET ADM=$GET(^FHPT("AW",WRD,FHDFN))
DO PAT
+10 DO P5
+11 KILL %,A1,A2,ADM,BMI,CLR,DA,DD,DFN,DIC,DTE,FHDUZ,FHOR,FHORD,FHTF
+12 KILL GMRVSTR,HT,L,LST,MONIFN,MONTX,N,NOW,PX,STOP,TF,WRD,WT,X,X0,Y
+13 KILL I,FHTMO,FHTFLG,FHTFLG1,FHTFLG2,FHEDT,FHTICK,FHTDFN,FHTDT1,FHWTDT,FHHTDT,WARD,FHGMDT
+14 KILL A,A0,AGE,BID,DEAD,FDA,FHAGE,FHBID,FHCLIN,FHDFN,FHI,FHI115,FHJ,FHJDAT,FHDFN
+15 KILL FHPTNM,FHPCZN,FHSEX,FHSSN,FHHDAT,FILE,HTM,IEN,IEN200,NAM,PID,SEX
+16 QUIT
PAT ; Check a patient
+1 DO PATNAME^FHOMUTL
IF DFN=""
QUIT
+2 SET Y=^DPT(DFN,0)
SET NAM=$PIECE(Y,"^",1)
SET SEX=$PIECE(Y,"^",2)
SET DOB=$PIECE(Y,"^",3)
+3 SET AGE=""
IF DOB'=""
SET AGE=$EXTRACT(NOW,1,3)-$EXTRACT(DOB,1,3)-($EXTRACT(NOW,4,7)<$EXTRACT(DOB,4,7))
+4 SET DEAD=$PIECE($GET(^DPT(DFN,.35)),"^",1)
if DEAD'=""
QUIT
+5 ;creates alert for nutrition assessment(follow-up dt & food/drug interaction.
DO ALRT^FHASM2A
+6 ;
P0 ; Calculate BMI
+1 SET GMRVSTR="WT"
DO EN6^GMRVUTL
SET WT=$PIECE(X,"^",8)
SET FHWTDT=$PIECE(X,"^",1)
+2 SET GMRVSTR="HT"
DO EN6^GMRVUTL
SET HT=$PIECE(X,"^",8)
SET FHHTDT=$PIECE(X,"^",1)
+3 SET FHGMDT=$SELECT(FHWTDT>FHHTDT:FHWTDT,FHHTDT>FHWTDT:FHHTDT,1:FHWTDT)
+4 SET BMI=""
IF WT
IF HT
SET A2=HT*.0254
SET BMI=+$JUSTIFY(WT/2.2/(A2*A2),0,1)
+5 IF $GET(BMI)=""!($GET(BMI)'<18.5)
GOTO P1
+6 SET MONTX="Monitor: BMI < 18.5"
SET DTE=NOW
+7 SET N=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
IF 'N
IF (FHGMDT>(FHEDT-7))
DO FIL
GOTO P1
+8 IF 'N
GOTO P1
+9 ; Check if been 30 days
+10 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
+11 SET X=$$FMDIFF^XLFDT(DTE,LST)
IF (X>30)
DO FIL
P1 ; Check for current Tubefeeding
+1 SET TF=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",4)
IF 'TF
GOTO P2
+2 SET MONTX="Monitor: On Tubefeeding"
SET DTE=NOW
+3 SET N=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
IF 'N
DO FIL
GOTO P2
+4 ; Check if been 7 days
+5 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
+6 SET X=$$FMDIFF^XLFDT(DTE,LST)
IF X>7
DO FIL
P2 ; Check for Hyperals
+1 SET MONTX=""
SET DTE=NOW
+2 DO PSS435^PSS55(DFN,,"FHIV")
FOR DA=0:0
SET DA=$ORDER(^TMP($JOB,"FHIV",DA))
if DA<1
QUIT
Begin DoDot:1
+3 SET (X0,HTM)=$PIECE($GET(^TMP($JOB,"FHIV",DA,.02)),"^",2)
IF X0>NOW
QUIT
+4 SET MONTX="Monitor: On Hyperals"
DO FIL
QUIT
End DoDot:1
+5 ;
P3 ; Check for Serum Albumin
+1 SET MONTX=""
SET PX=6
DO LAB^FHASM4
IF $DATA(^TMP($JOB,"LRTST"))
Begin DoDot:1
+2 FOR L=0:0
SET L=$ORDER(^TMP($JOB,"LRTST",L))
if L<1
QUIT
SET Y=$TRANSLATE($PIECE(^(L),"^",6)," ","")
IF Y'?1A.E
IF Y<2.8
SET MONTX="Monitor: Albumin < 2.8"
SET DTE=$PIECE(^(L),"^",7)
End DoDot:1
+3 IF MONTX=""
GOTO P4
+4 SET N=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
+5 ;process new Albumin if old test date is within 7 days.
+6 IF 'N
SET X=$$FMDIFF^XLFDT(NOW,DTE)
IF X<8
DO FIL
GOTO P4
+7 IF 'N
GOTO P4
+8 ; Check if same test
+9 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
IF DTE>LST
DO FIL
+10 ;
P4 ; Check for NPO+Clr Liq > 3 days
+1 ;Get last diet sequence record
SET A1=NOW
SET A1=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",A1),-1)
+2 ;Quit if none found
IF 'A1
QUIT
+3 ;Get diet order number
SET FHORD=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"AC",A1,0)),"^",2)
+4 ;Quit if none found
IF 'FHORD
QUIT
+5 ;Get diet order
SET FHOR=$GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
+6 ;Check if diet order is NPO or clear liquid, if not set DTE to null
+7 SET DTE=$SELECT($PIECE(FHOR,"^",7)="N":A1,$PIECE(FHOR,"^",2)=CLR:A1,1:"")
+8 ;If DTE is not null process record
IF DTE'=""
Begin DoDot:1
+9 ;Quit if pending NPO+Clr Liq order
IF DTE'<NOW
QUIT
+10 ;Check if NPO+Clr Liq order is less than 3 days old, if true quit
+11 SET X=$$FMDIFF^XLFDT(NOW,DTE)
if X<3
QUIT
+12 ;Prepare to file NPO+Clr Liq monitor
+13 SET MONTX="Monitor: NPO+Clr Liq > 3 days"
SET DTE=NOW
+14 ;Get NPO+Clr Liq monitor record for this patient, this admission
+15 SET N=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
+16 ;If NPO+Clr Liq monitor does not exist for this patient, this admission, file monitor
+17 IF 'N
DO FIL
QUIT
+18 ;Get file date of last NPO/CLR LIQ monitor
+19 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
+20 ;Check if monitor record is older than 3 days, if true file monitor
+21 SET X=$$FMDIFF^XLFDT(NOW,LST)
IF X>3
DO FIL
End DoDot:1
+22 QUIT
P5 ;clear personalized tickler and quit
+1 FOR FHI=0:0
SET FHI=$ORDER(^FH(119,FHI))
if FHI'>0
QUIT
FOR FHJ=0:0
SET FHJ=$ORDER(^FH(119,FHI,"I",FHJ))
if FHJ'>0
QUIT
Begin DoDot:1
+2 SET FHJDAT=$GET(^FH(119,FHI,"I",FHJ,0))
+3 if $PIECE(FHJDAT,U,2)'="X"
QUIT
+4 IF $PIECE(FHJDAT,U,1)<NOW
KILL ^FH(119,FHI,"I",FHJ)
End DoDot:1
+5 QUIT
CLR ; Find Clear Liquid
+1 SET CLR=$ORDER(^FH(111,"B","CLEAR LIQUID",0))
if CLR
QUIT
+2 SET CLR=$ORDER(^FH(111,"C","CLEAR LIQUID",0))
if CLR
QUIT
+3 SET CLR=$ORDER(^FH(111,"C","CLR LIQ",0))
if CLR
QUIT
+4 SET CLR=$ORDER(^FH(111,"C","CL",0))
if CLR
QUIT
+5 QUIT
FIL ; File Monitor
+1 DO PATNAME^FHOMUTL
+2 ;Check monitor ticklers on file
+3 SET (FHTFLG1,FHTFLG2)=0
+4 ;Process dietitians for the ward
+5 FOR A=0:0
SET A=$ORDER(^FH(119.6,WRD,2,A))
if A'>0
QUIT
Begin DoDot:1
+6 SET FHDUZ=$PIECE($GET(^FH(119.6,WRD,2,A,0)),U,1)
SET FHTFLG=0
SET FHTFLG1=FHTFLG1+1
+7 ;If FHDUZ is null for any reason go to next dietitian
+8 IF FHDUZ=""
SET FHTFLG2=FHTFLG2+1
QUIT
+9 ;Process the ticklers for the dietitian
+10 FOR I=0:0
SET I=$ORDER(^FH(119,FHDUZ,"I",I))
if I'>0
QUIT
Begin DoDot:2
+11 SET FHTDT1=$PIECE(I,".",1)
+12 SET FHTICK=^FH(119,FHDUZ,"I",I,0)
+13 SET FHTMO=$PIECE(FHTICK,"^",3)
+14 SET FHTDFN=$PIECE(FHTICK,"^",4)
+15 IF (FHTMO=MONTX)
IF (FHTDFN=DFN)
IF (FHTDT1=FHEDT)
SET FHTFLG=1
SET FHTFLG2=FHTFLG2+1
End DoDot:2
+16 ;Only one monitor for the same day, same clinicin and same patient
if FHTFLG
QUIT
End DoDot:1
+17 ;Quit if all clinicians for a ward meet the conditions of one monitor for the same day, same clinician, same patient
+18 IF FHTFLG1=FHTFLG2
QUIT
+19 ;File montior for patient
+20 LOCK +^FHPT(FHDFN,"A",ADM,"MO",0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
+21 IF '$DATA(^FHPT(FHDFN,"A",ADM,"MO",0))
SET ^FHPT(FHDFN,"A",ADM,"MO",0)="^115.11^^"
+22 LOCK -^FHPT(FHDFN,"A",ADM,"MO",0)
+23 KILL DIC,DD,DO,DINUM
SET DIC="^FHPT(FHDFN,""A"",ADM,""MO"","
SET DIC(0)="L"
SET DA(1)=ADM
SET DA(2)=FHDFN
SET DLAYGO=115
SET X=MONTX
DO FILE^DICN
KILL DIC,DLAYGO
+24 if Y<1
QUIT
SET MONIFN=+Y
+25 SET $PIECE(^FHPT(FHDFN,"A",ADM,"MO",MONIFN,0),"^",2)=DTE
SET ^FHPT(FHDFN,"A",ADM,"MO","AC",DTE,MONIFN)=""
+26 ;Creating tickler file entries for clinicians
+27 FOR A=0:0
SET A=$ORDER(^FH(119.6,WRD,2,A))
if A'>0
QUIT
Begin DoDot:1
+28 SET FHDUZ=$PIECE($GET(^FH(119.6,WRD,2,A,0)),U,1)
+29 ;If FHDUZ is null for any reason go to next clinician
+30 IF FHDUZ=""
QUIT
+31 ;Build tickler record
+32 SET FHTF=DTE_"^M^"_MONTX_"^"_DFN_"^"_ADM_"^"_MONIFN
+33 ;File tickler record
DO FILE^FHCTF2
End DoDot:1
+34 ;Check to determine if monitor tickler alerts are enabled.
+35 ;If enabled, send tickler alert
+36 ;PATCH 55 set a different code for each alert
+37 IF (MONTX["BMI")
IF ($PIECE($GET(^FH(119.6,WRD,1)),"^",5)="Y")
SET FHCODE=3
DO ALRT
QUIT
+38 IF (MONTX["Tubefeed")
IF ($PIECE($GET(^FH(119.6,WRD,1)),"^",6)="Y")
SET FHCODE=4
DO ALRT
QUIT
+39 IF (MONTX["Hyperals")
IF ($PIECE($GET(^FH(119.6,WRD,1)),"^",7)="Y")
SET FHCODE=5
DO ALRT
QUIT
+40 IF (MONTX["Albumin")
IF ($PIECE($GET(^FH(119.6,WRD,1)),"^",8)="Y")
SET FHCODE=6
DO ALRT
QUIT
+41 IF (MONTX["NPO+Clr")
IF ($PIECE($GET(^FH(119.6,WRD,1)),"^",9)="Y")
SET FHCODE=7
DO ALRT
QUIT
+42 QUIT
+43 ;
ALRT ;Send alerts
+1 FOR A=0:0
SET A=$ORDER(^FH(119.6,WRD,2,A))
if A'>0
QUIT
Begin DoDot:1
+2 KILL XQA,XQAID,XQAMSG,XQAOPT,XQAROU
+3 SET FHDUZ=$PIECE($GET(^FH(119.6,WRD,2,A,0)),U,1)
+4 IF FHDUZ=""
QUIT
+5 SET FHCLIN=$PIECE($$GET1^DIQ(200,FHDUZ_",",.01),",")
+6 ;S XQAID="FH,"_$J_","_$TR($H,",")
+7 ;p55
SET XQAID="FH,"_DFN_","_FHCODE
+8 SET XQA(FHDUZ)=""
+9 ;S XQAOPT="FHCTF2" p55
+10 SET XQAMSG=$EXTRACT($PIECE(FHPTNM,","),1,9)_" ("_$EXTRACT(FHPTNM,1,1)_$PIECE(FHSSN,"-",3)_"): "
+11 SET XQAMSG=XQAMSG_" "_MONTX_" "_$EXTRACT(DTE,4,5)_"/"_$EXTRACT(DTE,6,7)_"/"_$EXTRACT(DTE,2,3)_" Clinician: "_$GET(FHCLIN)
+12 DO SETUP^XQALERT
End DoDot:1
+13 QUIT
