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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPST2 6003 printed Oct 16, 2024@17:55:38 Page 2
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
