- FHXOR3 ; HISC/NCA - Order Entry Post-Init ;6/17/96 15:36
- ;;5.5;DIETETICS;;Jan 28, 2005
- Q:'$D(^ORD(101,0))
- ; Add OE/RR protocols
- S FHX=$O(^ORD(101,"B","FH EVSEND OR",0)) I 'FHX S NAM="FH EVSEND OR",TXT="Dietetics Send Event Message To OR",TXT1="This protocol is used to send HL7 message to Order Entry 3 or higher from Dietetics." D PKG,AD
- S FHX=$O(^ORD(101,"B","FH RECEIVE",0)) I 'FHX S NAM="FH RECEIVE",TXT="Dietetics Receive OR Event",ACT="D EN^FHWOR(.XQORMSG)",TXT1="This protocol is used to receive HL7 message from Order Entry 3 or higher." D PKG,AD1
- S FHX=$O(^ORD(101,"B","FH ORDERABLE ITEM UPDATE",0))
- I 'FHX S NAM="FH ORDERABLE ITEM UPDATE",TXT="Dietetics Send Orderable Item Update To OR",TXT1="This protocol is used to send orderable item updates HL7 messages to Order Entry 3 or higher from Dietetics." D PKG,AD
- S X=" ;;FH EVSEND OR;OR RECEIVE" D AD2
- S X=" ;;FH ORDERABLE ITEM UPDATE;OR ITEM RECEIVE" D AD2
- S X=" ;;OR EVSEND FH;FH RECEIVE" D AD2
- KIL K ACT,DA,DIC,DIE,DIK,DLAYGO,DR,FHX,FHXA,LL,NAM,PKG,TXT,TXT1,TYP,X,Y
- Q
- PKG S PKG=$O(^DIC(9.4,"C","FH",0)) Q
- AD ; Add extended protocols
- W !?2,"Filing protocol ",NAM
- K DIC S DIC="^ORD(101,",DIC(0)="L",DLAYGO=101,DIC("DR")="1///^S X=TXT;3.5///^S X=TXT1;4///X;12////^S X=PKG",X=NAM D ^DIC K DA,DIC,DLAYGO,X
- Q
- AD1 ; Filing the Dietetics Protocols
- W !?2,"Filing protocol ",NAM
- K DIC S DIC="^ORD(101,",DIC(0)="L",DLAYGO=101,DIC("DR")="1///^S X=TXT;3.5///^S X=TXT1;4///A;12////^S X=PKG;20////^S X=ACT",X=NAM D ^DIC K DA,DIC,DLAYGO,X
- Q
- AD2 ; Add Dietetic protocol to Order Entry 3
- S DA(1)=$O(^ORD(101,"B",$P(X,";",3),0)) I 'DA(1) K DA Q
- K DIC S:'$D(^ORD(101,DA(1),10,0)) ^(0)="^101.01PA^^"
- S FHX=$O(^ORD(101,"B",$P(X,";",4),0)) I 'FHX Q
- S FHXA=$O(^ORD(101,DA(1),10,"B",FHX,0)) I FHXA Q
- S DIC("DR")="3///1"
- S DIC="^ORD(101,"_DA(1)_",10,",DIC(0)="L",DLAYGO=101,X=$P(X,";",4) D ^DIC
- K DA,DIC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHXOR3 1900 printed Mar 13, 2025@21:00:25 Page 2
- FHXOR3 ; HISC/NCA - Order Entry Post-Init ;6/17/96 15:36
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 if '$DATA(^ORD(101,0))
- QUIT
- +3 ; Add OE/RR protocols
- +4 SET FHX=$ORDER(^ORD(101,"B","FH EVSEND OR",0))
- IF 'FHX
- SET NAM="FH EVSEND OR"
- SET TXT="Dietetics Send Event Message To OR"
- SET TXT1="This protocol is used to send HL7 message to Order Entry 3 or higher from Dietetics."
- DO PKG
- DO AD
- +5 SET FHX=$ORDER(^ORD(101,"B","FH RECEIVE",0))
- IF 'FHX
- SET NAM="FH RECEIVE"
- SET TXT="Dietetics Receive OR Event"
- SET ACT="D EN^FHWOR(.XQORMSG)"
- SET TXT1="This protocol is used to receive HL7 message from Order Entry 3 or higher."
- DO PKG
- DO AD1
- +6 SET FHX=$ORDER(^ORD(101,"B","FH ORDERABLE ITEM UPDATE",0))
- +7 IF 'FHX
- SET NAM="FH ORDERABLE ITEM UPDATE"
- SET TXT="Dietetics Send Orderable Item Update To OR"
- SET TXT1="This protocol is used to send orderable item updates HL7 messages to Order Entry 3 or higher from Dietetics."
- DO PKG
- DO AD
- +8 SET X=" ;;FH EVSEND OR;OR RECEIVE"
- DO AD2
- +9 SET X=" ;;FH ORDERABLE ITEM UPDATE;OR ITEM RECEIVE"
- DO AD2
- +10 SET X=" ;;OR EVSEND FH;FH RECEIVE"
- DO AD2
- KIL KILL ACT,DA,DIC,DIE,DIK,DLAYGO,DR,FHX,FHXA,LL,NAM,PKG,TXT,TXT1,TYP,X,Y
- +1 QUIT
- PKG SET PKG=$ORDER(^DIC(9.4,"C","FH",0))
- QUIT
- AD ; Add extended protocols
- +1 WRITE !?2,"Filing protocol ",NAM
- +2 KILL DIC
- SET DIC="^ORD(101,"
- SET DIC(0)="L"
- SET DLAYGO=101
- SET DIC("DR")="1///^S X=TXT;3.5///^S X=TXT1;4///X;12////^S X=PKG"
- SET X=NAM
- DO ^DIC
- KILL DA,DIC,DLAYGO,X
- +3 QUIT
- AD1 ; Filing the Dietetics Protocols
- +1 WRITE !?2,"Filing protocol ",NAM
- +2 KILL DIC
- SET DIC="^ORD(101,"
- SET DIC(0)="L"
- SET DLAYGO=101
- SET DIC("DR")="1///^S X=TXT;3.5///^S X=TXT1;4///A;12////^S X=PKG;20////^S X=ACT"
- SET X=NAM
- DO ^DIC
- KILL DA,DIC,DLAYGO,X
- +3 QUIT
- AD2 ; Add Dietetic protocol to Order Entry 3
- +1 SET DA(1)=$ORDER(^ORD(101,"B",$PIECE(X,";",3),0))
- IF 'DA(1)
- KILL DA
- QUIT
- +2 KILL DIC
- if '$DATA(^ORD(101,DA(1),10,0))
- SET ^(0)="^101.01PA^^"
- +3 SET FHX=$ORDER(^ORD(101,"B",$PIECE(X,";",4),0))
- IF 'FHX
- QUIT
- +4 SET FHXA=$ORDER(^ORD(101,DA(1),10,"B",FHX,0))
- IF FHXA
- QUIT
- +5 SET DIC("DR")="3///1"
- +6 SET DIC="^ORD(101,"_DA(1)_",10,"
- SET DIC(0)="L"
- SET DLAYGO=101
- SET X=$PIECE(X,";",4)
- DO ^DIC
- +7 KILL DA,DIC
- +8 QUIT
