111 lines
5.1 KiB
Mathematica
111 lines
5.1 KiB
Mathematica
FHOMWOR ;Hines OIFO/RTK OUTPATIENT MEALS/HL7 MESSAGING ;10/21/03 10:15
|
|
;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
|
|
S FHDFN="",FHZ115="P"_DFN D ADD^FHOMDPA
|
|
I 'FHDFN S TXT="Outpatient not found" D GETOR^FHWOR,ERR Q
|
|
;Decode FHMSG(3) - PV1
|
|
S FHX=$G(FHMSG(3))
|
|
I $E(FHX,1,3)'="PV1" S TXT="3rd msg not PV1" D GETOR^FHWOR,ERR Q
|
|
S FHLOC=$P($P(FHX,"|",4),U,1)
|
|
I FHLOC="" S TXT="Missing Location" D GETOR^FHWOR,ERR Q
|
|
S FHLOC=$O(^FH(119.6,"AL",FHLOC,""))
|
|
I 'FHLOC S TXT="Invalid Location" D GETOR^FHWOR,ERR Q
|
|
;Decode FHMSG(4) - ORC
|
|
S FHX=$G(FHMSG(4))
|
|
I $E(FHX,1,3)'="ORC" S TXT="4th msg not ORC" D GETOR^FHWOR,ERR Q
|
|
S FHORN=$P(FHX,"|",3),FHORN=+FHORN,FILL=$P(FHX,"|",4)
|
|
S FHDUR=$P(FHX,"|",8),FHDOW=$P(FHDUR,U,2)
|
|
S DATE=$E($P(FHDUR,U,4),1,8) D CVT^FHWOR S STDT=DATE,FHOSTDT=STDT
|
|
S DATE=$P(FHDUR,U,5) D CVT^FHWOR S ENDT=DATE I ENDT'="" S ENDT=ENDT_.99
|
|
I ENDT="" S ENDT=9999999.99
|
|
S ACT=$P(FHX,"|",2) I ACT="CA"!(ACT="DC") D CANCEL Q
|
|
I ACT="NA" D NA Q
|
|
I ACT="SS" D OMSTAT^FHWORR Q
|
|
I ACT'="NW" S TXT="Action not NW, CA or DC" D GETOR^FHWOR,ERR Q
|
|
D NOW^%DTC S FHNOW=$P(%,".",1)
|
|
I STDT=""!(STDT<FHNOW) S TXT="Start Date not valid" D GETOR^FHWOR,ERR Q
|
|
I ENDT<STDT S TXT="End Date not valid" D GETOR^FHWOR,ERR Q
|
|
S FHPV=$P(FHX,"|",13),FHEFF=$P(FHX,"|",16)
|
|
I FHEFF="" S TXT="No effective date" D ERR Q
|
|
;Decode FHMSG(5) - ODS/ODT
|
|
S FHX=$G(FHMSG(5))
|
|
S FHINST=$P(FHX,"|",4),FHBAG="N" I FHINST="bagged" S FHBAG="Y"
|
|
S FHSVCP=$P($P(FHX,"|",3),U,4)
|
|
I $E(FHX,1,3)="ODT" D HL7SET^FHOMRE1 Q ;EARLY/LATE
|
|
I $E(FHX,1,3)="OBR" D HL7SET^FHOMIP Q ;ISOLATION/PRECAUTION
|
|
I $E(FHX,1,3)'="ODS" S TXT="5th message not ODT or ODS as expected" D GETOR^FHWOR,ERR Q
|
|
S FHTYPC=$P(FHX,"|",2) I FHTYPC="ZE" D HL7SET^FHOMRT1 Q ;TUBEFEEDING
|
|
S FHDTX=$P(FHX,"|",4),FHDIET=$P(FHDTX,U,4),FHDTX=$E(FHDTX,4,$L(FHDTX))
|
|
S FHCOM=$P(FHX,"|",5),FHM3=$P(FHX,"|",3)
|
|
I $E(FHDTX,1,4)="FH-6" D HL7SET^FHOMRA1 Q ;ADDITIONAL ORDERS
|
|
S FHMEAL=$S(FHM3=1:"B",FHM3=3:"N",FHM3=5:"E",1:"")
|
|
I FHMEAL="" S TXT="Meal missing" D GETOR^FHWOR,ERR Q
|
|
I FHDIET="" S TXT="Missing diet" D GETOR^FHWOR,ERR Q
|
|
I '$D(^FH(111,FHDIET)) S TXT="Invalid diet" D GETOR^FHWOR,ERR Q
|
|
I FHTYPC="S" D SM ;SPECIAL MEAL REQUEST
|
|
I FHTYPC="D" D RM I $G(FHAIL)'="" Q ;RECURRING MEAL ORDER
|
|
D SEND^FHWOR Q
|
|
SM ; Special Meal Request
|
|
; FHDFN,FHLOC set at top of FHOMWOR
|
|
D NOW^%DTC S FHNOW=%
|
|
S FHDUZ=$P($G(FHMSG(4)),"|",11),FHSTAT="P"
|
|
I FHDUZ'="",$D(^XUSEC("FHAUTH",FHDUZ)) S FHSTAT="A"
|
|
S FHQEL=1 D SETNODE^FHOMSR1
|
|
S FILL="S;"_FHSMID
|
|
Q
|
|
RM ;
|
|
; Recurring orders from CPRS will only have ONE diet, not up to 5 like
|
|
; for NonVA patients/inpatients therefore can set FHDIETX1-5 = NULL
|
|
; FHDFN,FHLOC set at top of FHOMWOR
|
|
S FHMPNUM=$O(^FHPT(FHDFN,"OP","C",""),-1) I FHMPNUM="" S FHMPNUM=0
|
|
S FHMPNUM=FHMPNUM+1
|
|
S (FHAIL,FHRMBD,FHDIETX(1),FHDIETX(2),FHDIETX(3),FHDIETX(4),FHDIETX(5))=""
|
|
S (C,FHENDL)=0,STDTLP=STDT,FHDZ="" F Q:FHENDL=1 D
|
|
.S X=STDTLP D H^%DTC S:%Y=0 %Y=7 S FHDZ=FHDZ_%Y_"^",X1=STDTLP,X2=1
|
|
.D C^%DTC S STDTLP=X,C=C+1 I STDTLP>ENDT!(C>6) S FHENDL=1 Q
|
|
S FHDAYS="" F FHH=1:1:7 S FHPCE=$P(FHDOW,"~",FHH) Q:FHPCE="" D
|
|
.S FHD3=$E(FHPCE,3)
|
|
.I FHD3'>0,FHD3'<8 Q
|
|
.I FHDZ'[FHD3 Q
|
|
.S FHDAYS=FHDAYS_$E("MTWRFSX",FHD3)
|
|
I FHDAYS="",$E(STDT,1,7)'=$E(ENDT,1,7) S (TXT,FHAIL)="Day of week invalid or not within date range" D GETOR^FHWOR,ERR Q
|
|
I FHDAYS="",$E(STDT,1,7)=$E(ENDT,1,7) S X=$E(STDT,1,7) D DOW^%DTC S FHDAYS=$E("XMTWRFS",Y+1)
|
|
D SETNODE^FHOMRO1
|
|
S FILL="R;"_FHMPNUM_";"_STDT_";"_ENDT_";"_FHDAYS_";"_FHMEAL
|
|
Q
|
|
CANCEL ;Cancel outpatient orders
|
|
S FHENDT=ENDT,FHX=$G(FHMSG(4)),FILL=$P(FHX,"|",4),FHMPNUM=""
|
|
S FHORSAV=FHORN,FHILSAV=FILL,FHACTSV=ACT
|
|
S FHTYPE=$P(FILL,";",1) I FHTYPE="R" S FHMPNUM=$P(FILL,";",2)
|
|
I "AEIGSRT"'[FHTYPE S TXT="Invalid cancel code" D ERR Q
|
|
S X1=STDT,X2=-1 D C^%DTC S STDT1=X
|
|
I "AET"[FHTYPE F FHRMDT=STDT1:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>FHENDT) D
|
|
.F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0 D
|
|
..I FHTYPE="A" D CANAO^FHOMRC1 Q
|
|
..I FHTYPE="E" D CANEL^FHOMRC1 Q
|
|
..I FHTYPE="T" D CANTF^FHOMRC1 Q
|
|
I FHTYPE="R" F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","C",FHMPNUM,FHRNUM)) Q:FHRNUM'>0 S FHRMDT=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1) D CANRM^FHOMRC1,ASSOC^FHOMRC2
|
|
I FHTYPE="I" D CAN^FHOMIP
|
|
I FHTYPE="S" S FHSMID=$P(FILL,";",2),FHCDT=FHDFN_"^"_FHSMID D CAN^FHOMSC1,CNSMEL^FHOMRC2 ;cancel a SM and associated SM Late Tray
|
|
I FHTYPE="G" S FHSMID=$P(FILL,";",2),FHCDT=FHDFN_"^"_FHSMID D CNSMEL^FHOMRC2 ;cancel a SM Late Tray only
|
|
S FHORN=FHORSAV,FILL=FHILSAV,ACT=FHACTSV D CSEND^FHWOR Q
|
|
Q
|
|
NA ;Number assign for outpatient
|
|
S FILL=$P(FHX,"|",4)
|
|
S FHTYPE=$P(FILL,";",1) S (FHMPN,FHRNUM)=+$P(FILL,";",2)
|
|
D NA^FHOMWOR1
|
|
Q
|
|
ERR ;
|
|
K MSG D RMSH^FHWOR ;Sets MSG(1) & MSG(2)
|
|
S ACT="UA" I $P(FHMSG(4),"|",2)="CA" S ACT="U"_$E($P(FHMSG(4),"|",2),1)
|
|
S $P(MSG(3),"|",1,2)="ORC|"_ACT,$P(MSG(3),"|",3)=FHORN
|
|
S $P(MSG(3),"|",4)=$P(FHMSG(3),"|",4)
|
|
S $P(MSG(3),"|",13)=$P(FHMSG(3),"|",13)
|
|
S $P(MSG(3),"|",16)=$P(FHMSG(3),"|",16),$P(MSG(3),"|",17)=TXT
|
|
;
|
|
;W ! F RK=0:0 S RK=$O(MSG(RK)) Q:RK'>0 W !," MSG"_RK_"= ",MSG(RK)
|
|
;F RK=0:0 S RK=$O(FHMSG(RK)) Q:RK'>0 W !,"FHMSG"_RK_"= ",FHMSG(RK)
|
|
;W !!,"TXT=",TXT,!!
|
|
;
|
|
D EVSEND^FHWOR Q
|
|
Q
|