source: FOIAVistA/tag/r/DIETETICS-FH/FHPST2.m@ 643

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