- FHWTRN ; HISC/REL - Process Transfers ;3/17/92 14:39
- ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
- ;patch 4 - added alert if pt is transferred
- S (FHWRNEW,FHWROLD)=""
- S FHZ115="P"_DFN,FHWROLD="" D CHECK^FHOMDPA I FHDFN'="" D
- .S:ADM FHWROLD=$P($G(^FHPT(FHDFN,"A",ADM,0)),U,8)
- I FHOLD="" G T0
- ; Edit,Delete Transfers
- I $P(FHOLD,"^",18)=$P(FHNEW,"^",18) G EX
- S XT=$P(FHOLD,"^",18)
- I "^1^2^3^"[("^"_XT_"^") D RET
- I "^22^23^24^"[("^"_XT_"^") D PASS
- T0 S XT=$P(FHNEW,"^",18)
- I "^1^2^3^"[("^"_XT_"^") D PASS
- I "^22^23^24^"[("^"_XT_"^") D RET
- EX D WRD^FHWADM
- G:'$G(FHDFN) KIL
- S:ADM FHWRNEW=$P($G(^FHPT(FHDFN,"A",ADM,0)),U,8)
- I FHWRNEW,(FHWROLD'=FHWRNEW) D XQAL ;process alert for transfer
- G KIL
- PASS ; Place on Pass
- S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
- D SET Q:FHLD="P" Q:'$D(^FHPT(FHDFN,"A",ADM))
- S FHOR="^^^^",FHLD="P",TYP="",D1=X1,D2="",D4=0,COM="" D STR^FHORD7 Q
- RET ; Remove from Pass
- D SET I FHLD'="P",FHLD'="X" Q
- S X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),D1=$P(X,"^",9),D2=$S(D1'>X1:X1,1:D1)
- S $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",10)=D2
- S A2=0 F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1!(KK>X1) S A2=KK
- Q:'A2 Q:$P(^FHPT(FHDFN,"A",ADM,"AC",A2,0),"^",2)'=FHORD
- F K9=A2-.000001:0 S K9=$O(^FHPT(FHDFN,"A",ADM,"AC",K9)) Q:K9<1 I $P(^(K9,0),"^",2)=FHORD S D1=K9 D S0^FHORD3
- D UPD^FHORD7 Q
- SET D NOW^%DTC S NOW=%,DT=%\1,FHPV=DUZ,FHWF=$S($D(^ORD(101)):1,1:0)
- S X=$P($G(^DGPM(ADM,0)),"^",1),X1=$S(X'>NOW:NOW,1:X)
- S A1=0,(FHOR,FHLD)="" F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1!(KK>X1) S A1=KK
- Q:'A1 S FHORD=$P(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2),X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),FHOR=$P(X,"^",2,6),FHLD=$P(X,"^",7) Q
- ;
- XQAL ; Check a patient
- S FHCLIN=""
- D PATNAME^FHOMUTL I DFN="" Q
- D CLR
- D NOW^%DTC S NOW=%,FHEDT=$P(NOW,".")
- 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 FHDUZ=$P($G(^FH(119.6,FHWRNEW,0)),U,2)
- S:FHDUZ FHCLIN=$P($G(^VA(200,FHDUZ,0)),U,1)
- 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,'$P(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4) D FIL S MONIFN=N D TCK G P1
- I 'N,(FHGMDT>(FHEDT-7)) D FIL,TFIL 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,3) I X>30 D FIL,TFIL
- 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,'$P(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4) D FIL S MONIFN=N D TCK G P2
- I 'N D FIL,TFIL 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,3) I X>7 D FIL,TFIL
- 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=$P($G(^TMP($J,"FHIV",DA,.02)),"^",2) I X0>NOW Q
- .S MONTX="Monitor: On Hyperals" Q
- I MONTX'="" D FIL,TFIL
- 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) Q
- .Q
- I MONTX="" G P4
- S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
- I N,'$P(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4) D FIL S MONIFN=N D TCK G P4
- ;process new Albumin if old test date is within 7 days.
- I 'N S X=$$FMDIFF^XLFDT(NOW,DTE) I X<8 D FIL,TFIL 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,TFIL
- P4 ; Check for NPO+Clr Liq > 3 days
- S A1=NOW,DTE=NOW
- F D Q:'A1
- .S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1),-1) Q:'A1
- .S FHORD=$P($G(^FHPT(FHDFN,"A",ADM,"AC",A1,0)),"^",2) I 'FHORD S A1="" Q
- .S FHOR=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
- .I $P(FHOR,"^",7)="N" S DTE=A1 Q
- .I $P(FHOR,"^",2)=CLR S DTE=A1 Q
- .S A1="" Q
- I DTE'<NOW G P5
- S X=$$FMDIFF^XLFDT(NOW,DTE,3) G:X<3 P5
- S MONTX="Monitor: NPO+Clr Liq > 3 days",DTE=NOW
- S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
- I N,'$P(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4) D FIL S MONIFN=N D TCK G P5
- I 'N D FIL,TFIL G P5
- ; Check if been 3 days
- S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
- S X=$$FMDIFF^XLFDT(NOW,LST,3) I X>3 D FIL,TFIL
- P5 ; Done
- 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
- K XQA
- D PATNAME^FHOMUTL
- Q:(MONTX["BMI")&($P($G(^FH(119.6,FHWRNEW,1)),"^",5)'="Y")
- Q:(MONTX["Tubefeed")&($P($G(^FH(119.6,FHWRNEW,1)),"^",6)'="Y")
- Q:(MONTX["Hyperals")&($P($G(^FH(119.6,FHWRNEW,1)),"^",7)'="Y")
- Q:(MONTX["Albumin")&($P($G(^FH(119.6,FHWRNEW,1)),"^",8)'="Y")
- Q:(MONTX["NPO+Clr")&($P($G(^FH(119.6,FHWRNEW,1)),"^",9)'="Y")
- K XQA,XQAMSG,XQAOPT,XQAROU
- S XQAID="FH,"_$J_","_$H
- S XQAMSG=$E(FHPTNM,1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
- S XQAOPT="FHCTF2",XQAMSG=XQAMSG_" "_MONTX_" "_$E(DTE,4,5)_"/"_$E(DTE,6,7)_"/"_$E(DTE,2,3)_" Clinician: "_FHCLIN
- F A=0:0 S A=$O(^FH(119.6,FHWRNEW,2,A)) Q:A'>0 S TK=$P($G(^FH(119.6,FHWRNEW,2,A,0)),U,1),XQA(TK)=""
- I '$D(XQA(FHDUZ)) S XQA(FHDUZ)=""
- D SETUP^XQALERT
- Q
- TFIL ;File patient info
- L +^FHPT(FHDFN,"A",ADM,"MO",0)
- 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)=""
- TCK S FHTF=DTE_"^M^"_MONTX_"^"_DFN_"^"_ADM_"^"_MONIFN ;set tickler for a clinician
- D:FHDUZ FILE^FHCTF2
- Q
- ;
- KIL K %,A1,A2,COM,D1,D2,D4,FHDU,FHLD,FHOR,FHPV,FHX1,FHX2,FHX3,K,K9,KK,NOW,FHORD,TYP,X,X1,X2,X9
- K FHEDT,FHGMDT,FHWTDT,FHHTDT Q
- FHWTRN ; HISC/REL - Process Transfers ;3/17/92 14:39
- +1 ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
- +2 ;patch 4 - added alert if pt is transferred
- +3 SET (FHWRNEW,FHWROLD)=""
- +4 SET FHZ115="P"_DFN
- SET FHWROLD=""
- DO CHECK^FHOMDPA
- IF FHDFN'=""
- Begin DoDot:1
- +5 IF ADM
- SET FHWROLD=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),U,8)
- End DoDot:1
- +6 IF FHOLD=""
- GOTO T0
- +7 ; Edit,Delete Transfers
- +8 IF $PIECE(FHOLD,"^",18)=$PIECE(FHNEW,"^",18)
- GOTO EX
- +9 SET XT=$PIECE(FHOLD,"^",18)
- +10 IF "^1^2^3^"[("^"_XT_"^")
- DO RET
- +11 IF "^22^23^24^"[("^"_XT_"^")
- DO PASS
- T0 SET XT=$PIECE(FHNEW,"^",18)
- +1 IF "^1^2^3^"[("^"_XT_"^")
- DO PASS
- +2 IF "^22^23^24^"[("^"_XT_"^")
- DO RET
- EX DO WRD^FHWADM
- +1 IF '$GET(FHDFN)
- GOTO KIL
- +2 IF ADM
- SET FHWRNEW=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),U,8)
- +3 ;process alert for transfer
- IF FHWRNEW
- IF (FHWROLD'=FHWRNEW)
- DO XQAL
- +4 GOTO KIL
- PASS ; Place on Pass
- +1 SET FHZ115="P"_DFN
- DO CHECK^FHOMDPA
- IF FHDFN=""
- QUIT
- +2 DO SET
- IF FHLD="P"
- QUIT
- IF '$DATA(^FHPT(FHDFN,"A",ADM))
- QUIT
- +3 SET FHOR="^^^^"
- SET FHLD="P"
- SET TYP=""
- SET D1=X1
- SET D2=""
- SET D4=0
- SET COM=""
- DO STR^FHORD7
- QUIT
- RET ; Remove from Pass
- +1 DO SET
- IF FHLD'="P"
- IF FHLD'="X"
- QUIT
- +2 SET X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)
- SET D1=$PIECE(X,"^",9)
- SET D2=$SELECT(D1'>X1:X1,1:D1)
- +3 SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",10)=D2
- +4 SET A2=0
- FOR KK=0:0
- SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",KK))
- IF KK<1!(KK>X1)
- QUIT
- SET A2=KK
- +5 IF 'A2
- QUIT
- IF $PIECE(^FHPT(FHDFN,"A",ADM,"AC",A2,0),"^",2)'=FHORD
- QUIT
- +6 FOR K9=A2-.000001:0
- SET K9=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",K9))
- IF K9<1
- QUIT
- IF $PIECE(^(K9,0),"^",2)=FHORD
- SET D1=K9
- DO S0^FHORD3
- +7 DO UPD^FHORD7
- QUIT
- SET DO NOW^%DTC
- SET NOW=%
- SET DT=%\1
- SET FHPV=DUZ
- SET FHWF=$SELECT($DATA(^ORD(101)):1,1:0)
- +1 SET X=$PIECE($GET(^DGPM(ADM,0)),"^",1)
- SET X1=$SELECT(X'>NOW:NOW,1:X)
- +2 SET A1=0
- SET (FHOR,FHLD)=""
- FOR KK=0:0
- SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",KK))
- IF KK<1!(KK>X1)
- QUIT
- SET A1=KK
- +3 IF 'A1
- QUIT
- SET FHORD=$PIECE(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2)
- SET X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)
- SET FHOR=$PIECE(X,"^",2,6)
- SET FHLD=$PIECE(X,"^",7)
- QUIT
- +4 ;
- XQAL ; Check a patient
- +1 SET FHCLIN=""
- +2 DO PATNAME^FHOMUTL
- IF DFN=""
- QUIT
- +3 DO CLR
- +4 DO NOW^%DTC
- SET NOW=%
- SET FHEDT=$PIECE(NOW,".")
- +5 SET Y=^DPT(DFN,0)
- SET NAM=$PIECE(Y,"^",1)
- SET SEX=$PIECE(Y,"^",2)
- SET DOB=$PIECE(Y,"^",3)
- +6 SET AGE=""
- IF DOB'=""
- SET AGE=$EXTRACT(NOW,1,3)-$EXTRACT(DOB,1,3)-($EXTRACT(NOW,4,7)<$EXTRACT(DOB,4,7))
- +7 SET FHDUZ=$PIECE($GET(^FH(119.6,FHWRNEW,0)),U,2)
- +8 IF FHDUZ
- SET FHCLIN=$PIECE($GET(^VA(200,FHDUZ,0)),U,1)
- 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)
- +8 IF N
- IF '$PIECE(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4)
- DO FIL
- SET MONIFN=N
- DO TCK
- GOTO P1
- +9 IF 'N
- IF (FHGMDT>(FHEDT-7))
- DO FIL
- DO TFIL
- GOTO P1
- +10 IF 'N
- GOTO P1
- +11 ; Check if been 30 days
- +12 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
- +13 SET X=$$FMDIFF^XLFDT(DTE,LST,3)
- IF X>30
- DO FIL
- DO TFIL
- 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)
- +4 IF N
- IF '$PIECE(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4)
- DO FIL
- SET MONIFN=N
- DO TCK
- GOTO P2
- +5 IF 'N
- DO FIL
- DO TFIL
- GOTO P2
- +6 ; Check if been 7 days
- +7 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
- +8 SET X=$$FMDIFF^XLFDT(DTE,LST,3)
- IF X>7
- DO FIL
- DO TFIL
- 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=$PIECE($GET(^TMP($JOB,"FHIV",DA,.02)),"^",2)
- IF X0>NOW
- QUIT
- +4 SET MONTX="Monitor: On Hyperals"
- QUIT
- End DoDot:1
- +5 IF MONTX'=""
- DO FIL
- DO TFIL
- 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)
- QUIT
- +3 QUIT
- End DoDot:1
- +4 IF MONTX=""
- GOTO P4
- +5 SET N=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
- +6 IF N
- IF '$PIECE(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4)
- DO FIL
- SET MONIFN=N
- DO TCK
- GOTO P4
- +7 ;process new Albumin if old test date is within 7 days.
- +8 IF 'N
- SET X=$$FMDIFF^XLFDT(NOW,DTE)
- IF X<8
- DO FIL
- DO TFIL
- GOTO P4
- +9 IF 'N
- GOTO P4
- +10 ; Check if same test
- +11 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
- IF DTE>LST
- DO FIL
- DO TFIL
- P4 ; Check for NPO+Clr Liq > 3 days
- +1 SET A1=NOW
- SET DTE=NOW
- +2 FOR
- Begin DoDot:1
- +3 SET A1=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",A1),-1)
- IF 'A1
- QUIT
- +4 SET FHORD=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"AC",A1,0)),"^",2)
- IF 'FHORD
- SET A1=""
- QUIT
- +5 SET FHOR=$GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
- +6 IF $PIECE(FHOR,"^",7)="N"
- SET DTE=A1
- QUIT
- +7 IF $PIECE(FHOR,"^",2)=CLR
- SET DTE=A1
- QUIT
- +8 SET A1=""
- QUIT
- End DoDot:1
- IF 'A1
- QUIT
- +9 IF DTE'<NOW
- GOTO P5
- +10 SET X=$$FMDIFF^XLFDT(NOW,DTE,3)
- IF X<3
- GOTO P5
- +11 SET MONTX="Monitor: NPO+Clr Liq > 3 days"
- SET DTE=NOW
- +12 SET N=$ORDER(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
- +13 IF N
- IF '$PIECE(^FHPT(FHDFN,"A",ADM,"MO",N,0),U,4)
- DO FIL
- SET MONIFN=N
- DO TCK
- GOTO P5
- +14 IF 'N
- DO FIL
- DO TFIL
- GOTO P5
- +15 ; Check if been 3 days
- +16 SET LST=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
- +17 SET X=$$FMDIFF^XLFDT(NOW,LST,3)
- IF X>3
- DO FIL
- DO TFIL
- P5 ; Done
- +1 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 KILL XQA
- +2 DO PATNAME^FHOMUTL
- +3 IF (MONTX["BMI")&($PIECE($GET(^FH(119.6,FHWRNEW,1)),"^",5)'="Y")
- QUIT
- +4 IF (MONTX["Tubefeed")&($PIECE($GET(^FH(119.6,FHWRNEW,1)),"^",6)'="Y")
- QUIT
- +5 IF (MONTX["Hyperals")&($PIECE($GET(^FH(119.6,FHWRNEW,1)),"^",7)'="Y")
- QUIT
- +6 IF (MONTX["Albumin")&($PIECE($GET(^FH(119.6,FHWRNEW,1)),"^",8)'="Y")
- QUIT
- +7 IF (MONTX["NPO+Clr")&($PIECE($GET(^FH(119.6,FHWRNEW,1)),"^",9)'="Y")
- QUIT
- +8 KILL XQA,XQAMSG,XQAOPT,XQAROU
- +9 SET XQAID="FH,"_$JOB_","_$HOROLOG
- +10 SET XQAMSG=$EXTRACT(FHPTNM,1,9)_" ("_$EXTRACT(FHPTNM,1,1)_$PIECE(FHSSN,"-",3)_"): "
- +11 SET XQAOPT="FHCTF2"
- SET XQAMSG=XQAMSG_" "_MONTX_" "_$EXTRACT(DTE,4,5)_"/"_$EXTRACT(DTE,6,7)_"/"_$EXTRACT(DTE,2,3)_" Clinician: "_FHCLIN
- +12 FOR A=0:0
- SET A=$ORDER(^FH(119.6,FHWRNEW,2,A))
- IF A'>0
- QUIT
- SET TK=$PIECE($GET(^FH(119.6,FHWRNEW,2,A,0)),U,1)
- SET XQA(TK)=""
- +13 IF '$DATA(XQA(FHDUZ))
- SET XQA(FHDUZ)=""
- +14 DO SETUP^XQALERT
- +15 QUIT
- TFIL ;File patient info
- +1 LOCK +^FHPT(FHDFN,"A",ADM,"MO",0)
- +2 IF '$DATA(^FHPT(FHDFN,"A",ADM,"MO",0))
- SET ^FHPT(FHDFN,"A",ADM,"MO",0)="^115.11^^"
- +3 LOCK -^FHPT(FHDFN,"A",ADM,"MO",0)
- +4 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
- +5 IF Y<1
- QUIT
- SET MONIFN=+Y
- +6 SET $PIECE(^FHPT(FHDFN,"A",ADM,"MO",MONIFN,0),"^",2)=DTE
- SET ^FHPT(FHDFN,"A",ADM,"MO","AC",DTE,MONIFN)=""
- TCK ;set tickler for a clinician
- SET FHTF=DTE_"^M^"_MONTX_"^"_DFN_"^"_ADM_"^"_MONIFN
- +1 IF FHDUZ
- DO FILE^FHCTF2
- +2 QUIT
- +3 ;
- KIL KILL %,A1,A2,COM,D1,D2,D4,FHDU,FHLD,FHOR,FHPV,FHX1,FHX2,FHX3,K,K9,KK,NOW,FHORD,TYP,X,X1,X2,X9
- +1 KILL FHEDT,FHGMDT,FHWTDT,FHHTDT
- QUIT