123 lines
5.7 KiB
Mathematica
123 lines
5.7 KiB
Mathematica
FHPST2 ;Hines OIFO/RTK POST-INIT TO BACKFILL OM TO FILE #100 ;6/21/05 12:05
|
|
;;5.5;DIETETICS;**2**;Jan 28, 2005
|
|
;
|
|
;Loop thru all existing Recurring & Special Meals and send backdoor
|
|
;message to update Orders (#100) file.
|
|
;
|
|
;Recurring Meals
|
|
D NOW^%DTC S FHNOW=%,FHTODAY=$E(FHNOW,1,7)
|
|
F FHXRDT=0:0 S FHXRDT=$O(^FHPT("RM",FHXRDT)) Q:FHXRDT'>0 D
|
|
.F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHXRDT,FHDFN)) Q:FHDFN'>0 D
|
|
..F FHRM=0:0 S FHRM=$O(^FHPT("RM",FHXRDT,FHDFN,FHRM)) Q:FHRM'>0 D
|
|
...S FHDT=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),"^",1)
|
|
...S FHODT=$$FMTHL7^XLFDT(FHDT)
|
|
...S FHLOC=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),"^",3)
|
|
...S FHMPNUM=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),"^",6)
|
|
...I $D(^FHPT(FHDFN,"OP",FHRM,0)) D RM I $P(^FHPT(FHDFN,"OP",FHRM,0),"^",15)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,0)),U,12),FILL="R;"_FHMPNUM_";"_FHDT_";"_FHDT_";;" D MSHCA ;Send backdoor cancel
|
|
...I $D(^FHPT(FHDFN,"OP",FHRM,1)) D AO
|
|
...I $D(^FHPT(FHDFN,"OP",FHRM,2)) D EL
|
|
...I $D(^FHPT(FHDFN,"OP",FHRM,3)) D TF
|
|
;
|
|
;Special Meals
|
|
F FHXSDT=0:0 S FHXSDT=$O(^FHPT("SM",FHXSDT)) Q:FHXSDT'>0 D
|
|
.F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHXSDT,FHDFN)) Q:FHDFN'>0 D
|
|
..S FHODT=$$FMTHL7^XLFDT(FHXSDT)
|
|
..S FHLOC=$P($G(^FHPT(FHDFN,"SM",FHXSDT,0)),"^",3)
|
|
..I $D(^FHPT(FHDFN,"SM",FHXSDT,0)) D SM
|
|
Q
|
|
;
|
|
RM ;
|
|
I $P(^FHPT(FHDFN,"OP",FHRM,0),"^",12)>0 Q ;Backdoor already exists
|
|
S FHN0=$G(^FHPT(FHDFN,"OP",FHRM,0))
|
|
K MSG D MSHOM I 'DFN!('FHOLOC) Q
|
|
S FHMPNUM=$P(FHN0,"^",6),FHCLRK=$P(FHN0,"^",17) D GETSED
|
|
S (X,FHSTDT)=$P(FHN0,"^",1)
|
|
S FHMEAL=$P(FHN0,"^",4),FHDIET=$P(FHN0,"^",2),FHDIETX(1)=$P(FHN0,"^",7)
|
|
S FHDIETX(2)=$P(FHN0,"^",8),FHDIETX(3)=$P(FHN0,"^",9)
|
|
S FHDIETX(4)=$P(FHN0,"^",10),FHDIETX(5)=$P(FHN0,"^",11)
|
|
S FHOSTDT=$$FMTHL7^XLFDT(FHSTDT),FHOENDT=$$FMTHL7^XLFDT(FHENDT)
|
|
S FILL="R;"_FHMPNUM_";"_FHSTDT_";"_FHENDT_";"_FHDAYS_";"_FHMEAL
|
|
S MSG(4)="ORC|SN||"_FILL_"^FH||||^"_FHDAYS_"^^"_FHOSTDT_"^"_FHOENDT_"|||"_FHCLRK_"|||||"_FHOSTDT
|
|
I FHDIET'="" S FHODNM=$P($G(^FH(111,FHDIET,0)),U,1),MSG(5)="ODS|D|"_FHMEAL_"|^^^"_FHDIET_"^"_FHODNM_"^99FHD|"
|
|
I FHDIET="" D
|
|
.F N=0:0 S N=$O(FHDIETX(N)) Q:N'>0 Q:FHDIETX(N)="" S FHODNM=$P($G(^FH(111,FHDIETX(N),0)),U,1),MSG(N+4)="ODS|D|"_FHMEAL_"|^^^"_FHDIETX(N)_"^"_FHODNM_"^99FHD|"
|
|
D EVSEND^FHWOR
|
|
Q
|
|
AO ;
|
|
I $P(^FHPT(FHDFN,"OP",FHRM,1),"^",4)>0 Q ;Backdoor already exists
|
|
S FHN1=$G(^FHPT(FHDFN,"OP",FHRM,1))
|
|
K MSG D MSHOM I 'DFN!('FHOLOC) Q
|
|
S FILL="A;"_FHRM,FHTEXT=$P(FHN1,"^",1),FHCLRK=$P(FHN1,"^",2)
|
|
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"|||"_FHCLRK_"|||||"_FHTODAY
|
|
S MSG(5)="ODS|D||^^^FH-6^Additional Order^99OTH|"_FHTEXT
|
|
D EVSEND^FHWOR
|
|
I $P(^FHPT(FHDFN,"OP",FHRM,1),"^",5)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,1)),U,4),FILL="A;"_FHRM D MSHCA ;Send backdoor cancel
|
|
Q
|
|
EL ;
|
|
I $P(^FHPT(FHDFN,"OP",FHRM,2),"^",5)>0 Q ;Backdoor already exists
|
|
S FHN2=$G(^FHPT(FHDFN,"OP",FHRM,2))
|
|
K MSG D MSHOM I 'DFN!('FHOLOC) Q
|
|
S FILL="E;"_FHRM,FHEL="L",FHS=1,FHBAG=$P(FHN2,"^",2)
|
|
S FHCLRK=$P(FHN2,"^",3)
|
|
S FHOMELN=FHMEAL_FHEL_FHS,FHOBAG="" I FHBAG="Y" S FHOBAG="bagged"
|
|
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"|||"_FHCLRK_"|||||"_FHTODAY
|
|
S MSG(5)="ODT|LATE|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
|
|
D EVSEND^FHWOR
|
|
I $P(^FHPT(FHDFN,"OP",FHRM,2),"^",6)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,2)),U,5),FILL="E;"_FHRM D MSHCA ;Send backdoor cancel
|
|
Q
|
|
TF ;
|
|
I $P(^FHPT(FHDFN,"OP",FHRM,3),"^",4)>0 Q ;Backdoor already exists
|
|
S FHN3=$G(^FHPT(FHDFN,"OP",FHRM,3))
|
|
K MSG,TUN D MSHOM I 'DFN!('FHOLOC) Q
|
|
S FHTEXT=$P(FHN3,"^",1),FILL="T;"_FHRM,MNUM=4,TFCOM=FHTEXT
|
|
S FHCLRK=$P(FHN3,"^",6) D NOW^%DTC S FHNOW=%,SDT=FHDT
|
|
S MSG(MNUM)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"|||"_FHCLRK_"||"_FHCLRK_"|||"_FHNOW
|
|
F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"OP",FHRM,"TF",FHTF)) Q:FHTF'>0 S TUN(FHTF)=$G(^FHPT(FHDFN,"OP",FHRM,"TF",FHTF,0))
|
|
F FHTF=0:0 S FHTF=$O(TUN(FHTF)) Q:FHTF<1 S XX=$G(TUN(FHTF)) D TF1^FHWOR5
|
|
D EVSEND^FHWOR
|
|
I $P(^FHPT(FHDFN,"OP",FHRM,3),"^",5)="C" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRM,3)),U,4),FILL="T;"_FHRM D MSHCA ;Send backdoor cancel
|
|
Q
|
|
SM ;
|
|
I $P(^FHPT(FHDFN,"SM",FHXSDT,0),"^",12)>0 Q ;Backdoor already exists
|
|
S FHSN0=$G(^FHPT(FHDFN,"SM",FHXSDT,0))
|
|
K MSG D MSHOM I 'DFN!('FHOLOC) Q
|
|
S FILL="S;"_FHXSDT,FHMEAL=$P(FHSN0,"^",9),FHDIET=$P(FHSN0,"^",4)
|
|
S FHOMEAL=$S(FHMEAL="B":1,FHMEAL="N":3,FHMEAL="E":5,1:"")
|
|
S FHDIETNM=$P($G(^FH(111,FHDIET,0)),U,1),FHCLRK=$P(FHSN0,"^",5)
|
|
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"|||"_FHCLRK_"|||||"_FHNOW
|
|
S MSG(5)="ODS|S|"_FHOMEAL_"|^^^"_FHDIET_"^"_FHDIETNM_"^99FHD|"
|
|
D EVSEND^FHWOR
|
|
S FHSMST=$P(^FHPT(FHDFN,"SM",FHXSDT,0),"^",2)
|
|
I FHSMST="C"!(FHSMST="D") S FHORN=$P($G(^FHPT(FHDFN,"SM",FHXSDT,0)),U,12),FILL="S;"_FHXSDT D MSHCA ;Send backdoor cancel/deny
|
|
Q
|
|
MSHOM ;Code MSG for outpatient orders
|
|
D SITE^FH
|
|
D PATNAME^FHOMUTL I 'DFN Q
|
|
S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
|
|
S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
|
|
S FHOLOC=$G(^FH(119.6,FHLOC,"L",1,0)) I 'FHOLOC Q
|
|
S FHOLOCNM=$P($G(^SC(FHOLOC,0)),U,1)
|
|
S MSG(3)="PV1||O|"_FHOLOC_"^"_FHOLOCNM_"||||||||||||||||"
|
|
Q
|
|
MSHCA ;Code Cancel/Discontinue for outpatient orders
|
|
K MSG S ACT="OC" D SITE^FH S FHCATXT="Dietetics Canceled order."
|
|
D PATNAME^FHOMUTL I 'DFN Q
|
|
S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
|
|
S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
|
|
S DATE=$$FMTHL7^XLFDT(FHNOW)
|
|
S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||"_DUZ_"||"_DUZ_"|||"_DATE_"|"_FHCATXT
|
|
D EVSEND^FHWOR
|
|
Q
|
|
GETSED ;
|
|
K N1 S (FHDAYS,FHENDT,FHODAYS)=""
|
|
F FHRZ=0:0 S FHRZ=$O(^FHPT(FHDFN,"OP","C",FHMPNUM,FHRZ)) Q:FHRZ'>0 D
|
|
.S FHDAT=$P($G(^FHPT(FHDFN,"OP",FHRZ,0)),"^",1),X=FHDAT D DOW^%DTC
|
|
.S FHV=$S(Y=0:"X",Y=1:"M",Y=2:"T",Y=3:"W",Y=4:"R",Y=5:"F",1:"S")
|
|
.I FHDAYS'[FHV S FHDAYS=FHDAYS_FHV
|
|
.Q
|
|
S FHENDT=FHDAT
|
|
F N=1:1:7 S FH1=$E(FHDAYS,N) Q:FH1="" S M=$F("MTWRFSX",FH1)-1,N1(M)=""
|
|
F N=0:0 S N=$O(N1(N)) Q:N'>0 S FHODAYS=FHODAYS_"~QJ"_N
|
|
S FHODAYS=$E(FHODAYS,2,999)
|
|
S FHDAYS=FHODAYS Q
|