FHORR.m

FHORR ; HISC/NCA/JH - Diet Order Utilities For OE/RR Interface ;10/10/00  14:54

 ;;5.5;DIETETICS;;Jan 28, 2005

OE ; File OE/RR Diet Order For Re-instated Diet Order

 Q:$P(FHNO1,"^",7)="X"!($P(FHNO1,"^",7)="P")

 S FHO=$P(FHNO1,"^",2,6),VAL="" D VAL^FHWORP(FHO,.VAL) Q:VAL=""

 S FHNEW=$S($P(FHNO1,"^",7)'="":"N",1:"D")_";"_ADM_";"_FHORD1_";"_D2_";"_$P(FHNO1,"^",10)_";"_$P(FHNO1,"^",7)_";"_FHNO2_";"_$P(FHNO1,"^",8)_";"_0_";"_VAL

 S (FHSTS,FHDU)=$S(D2>NOW:8,1:6) S FHDIE=FHORD

 I $P(FHNO1,"^",7)="N" D NPO D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG S FHORD=FHDIE K FHDIE G SAV

 I $P(FHNO1,"^",7)="" D DO D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG

 S FHORD=FHDIE K FHDIE

SAV S:FHDU $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD1,0),"^",15)=FHDU Q

DO ; Code Re-instated Diet Orders

 K MSG S FILL=$G(FHNEW)

 S SDT=D2,DATE1="" D SET

 ; Code MSH, PID, and PV1

 D MSH^FHWOR

 ; code ORC

 S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_FHPV_"|||"_DATE

 ; Code ODS

 F A7=5:1 S A8=$P(FHNO1,"^",A7-3) Q:'A8  D

 .S MSG(A7)="ODS|ZT||^^^"_A8_"^"_$P($G(^FH(111,+A8,0)),"^",1)_"^99FHD" Q

 K A7,A8,DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT,VAL

 Q

NPO ; Code Re-instated NPO Order

 K MSG S FILL=$G(FHNEW) Q:FILL=""

 S SDT=D2,DATE1="" D SET

 ; Code MSH, PID, and PV1

 D MSH^FHWOR

 ; code ORC

 S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_FHPV_"|||"_DATE

 ; Code ODS

 S MSG(5)="ODS|D||^^^FH-5^NPO^99OTH|"_COM

 K DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT

 Q

SET ; Set Date/Time in HL7 format

 S DATR=$S($P(FHNO1,"^",10):$P(FHNO1,"^",10),1:"")

 S:SDT SDT=$$FMTHL7^XLFDT(SDT)

 S:NOW DATE=$$FMTHL7^XLFDT(NOW)

 S:DATR DATE1=$$FMTHL7^XLFDT(DATR) S:'DATE1 DATE1="" K DATR

 Q

ORD ; Get next order # for re-instate diet order

 L +^FHPT(FHDFN,"A",ADM,"DI",0)

 I '$D(^FHPT(FHDFN,"A",ADM,"DI",0)) S ^FHPT(FHDFN,"A",ADM,"DI",0)="^115.02A^^"

 S X=^FHPT(FHDFN,"A",ADM,"DI",0),FHORD1=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_FHORD1_"^"_($P(X,"^",4)+1)

 L -^FHPT(FHDFN,"A",ADM,"DI",0) Q:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD1))  G ORD

FHORR     ; HISC/NCA/JH - Diet Order Utilities For OE/RR Interface ;10/10/00  14:54

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

OE        ; File OE/RR Diet Order For Re-instated Diet Order

 +1        IF $PIECE(FHNO1,"^",7)="X"!($PIECE(FHNO1,"^",7)="P")

               QUIT 

 +2        SET FHO=$PIECE(FHNO1,"^",2,6)

           SET VAL=""

           DO VAL^FHWORP(FHO,.VAL)

           IF VAL=""

               QUIT 

 +3        SET FHNEW=$SELECT($PIECE(FHNO1,"^",7)'="":"N",1:"D")_";"_ADM_";"_FHORD1_";"_D2_";"_$PIECE(FHNO1,"^",10)_";"_$PIECE(FHNO1,"^",7)_";"_FHNO2_";"_$PIECE(FHNO1,"^",8)_";"_0_";"_VAL

 +4        SET (FHSTS,FHDU)=$SELECT(D2>NOW:8,1:6)

           SET FHDIE=FHORD

 +5        IF $PIECE(FHNO1,"^",7)="N"

               DO NPO

               IF $DATA(MSG)

                   DO MSG^XQOR("FH EVSEND OR",.MSG)

               KILL MSG

               SET FHORD=FHDIE

               KILL FHDIE

               GOTO SAV

 +6        IF $PIECE(FHNO1,"^",7)=""

               DO DO

               IF $DATA(MSG)

                   DO MSG^XQOR("FH EVSEND OR",.MSG)

               KILL MSG

 +7        SET FHORD=FHDIE

           KILL FHDIE

SAV        IF FHDU

               SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHORD1,0),"^",15)=FHDU

           QUIT 

DO        ; Code Re-instated Diet Orders

 +1        KILL MSG

           SET FILL=$GET(FHNEW)

 +2        SET SDT=D2

           SET DATE1=""

           DO SET

 +3       ; Code MSH, PID, and PV1

 +4        DO MSH^FHWOR

 +5       ; code ORC

 +6        SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_FHPV_"|||"_DATE

 +7       ; Code ODS

 +8        FOR A7=5:1

               SET A8=$PIECE(FHNO1,"^",A7-3)

               IF 'A8

                   QUIT 

               Begin DoDot:1

 +9                SET MSG(A7)="ODS|ZT||^^^"_A8_"^"_$PIECE($GET(^FH(111,+A8,0)),"^",1)_"^99FHD"

                   QUIT 

               End DoDot:1

 +10       KILL A7,A8,DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT,VAL

 +11       QUIT 

NPO       ; Code Re-instated NPO Order

 +1        KILL MSG

           SET FILL=$GET(FHNEW)

           IF FILL=""

               QUIT 

 +2        SET SDT=D2

           SET DATE1=""

           DO SET

 +3       ; Code MSH, PID, and PV1

 +4        DO MSH^FHWOR

 +5       ; code ORC

 +6        SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_FHPV_"|||"_DATE

 +7       ; Code ODS

 +8        SET MSG(5)="ODS|D||^^^FH-5^NPO^99OTH|"_COM

 +9        KILL DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT

 +10       QUIT 

SET       ; Set Date/Time in HL7 format

 +1        SET DATR=$SELECT($PIECE(FHNO1,"^",10):$PIECE(FHNO1,"^",10),1:"")

 +2        IF SDT

               SET SDT=$$FMTHL7^XLFDT(SDT)

 +3        IF NOW

               SET DATE=$$FMTHL7^XLFDT(NOW)

 +4        IF DATR

               SET DATE1=$$FMTHL7^XLFDT(DATR)

           IF 'DATE1

               SET DATE1=""

           KILL DATR

 +5        QUIT 

ORD       ; Get next order # for re-instate diet order

 +1        LOCK +^FHPT(FHDFN,"A",ADM,"DI",0)

 +2        IF '$DATA(^FHPT(FHDFN,"A",ADM,"DI",0))

               SET ^FHPT(FHDFN,"A",ADM,"DI",0)="^115.02A^^"

 +3        SET X=^FHPT(FHDFN,"A",ADM,"DI",0)

           SET FHORD1=$PIECE(X,"^",3)+1

           SET ^(0)=$PIECE(X,"^",1,2)_"^"_FHORD1_"^"_($PIECE(X,"^",4)+1)

 +4        LOCK -^FHPT(FHDFN,"A",ADM,"DI",0)

           IF '$DATA(^FHPT(FHDFN,"A",ADM,"DI",FHORD1))

               QUIT 

           GOTO ORD