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