source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHXOR3.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1FHXOR3 ; HISC/NCA - Order Entry Post-Init ;6/17/96 15:36
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 Q:'$D(^ORD(101,0))
4 ; Add OE/RR protocols
5 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
6 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
7 S FHX=$O(^ORD(101,"B","FH ORDERABLE ITEM UPDATE",0))
8 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
9 S X=" ;;FH EVSEND OR;OR RECEIVE" D AD2
10 S X=" ;;FH ORDERABLE ITEM UPDATE;OR ITEM RECEIVE" D AD2
11 S X=" ;;OR EVSEND FH;FH RECEIVE" D AD2
12KIL K ACT,DA,DIC,DIE,DIK,DLAYGO,DR,FHX,FHXA,LL,NAM,PKG,TXT,TXT1,TYP,X,Y
13 Q
14PKG S PKG=$O(^DIC(9.4,"C","FH",0)) Q
15AD ; Add extended protocols
16 W !?2,"Filing protocol ",NAM
17 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
18 Q
19AD1 ; Filing the Dietetics Protocols
20 W !?2,"Filing protocol ",NAM
21 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
22 Q
23AD2 ; Add Dietetic protocol to Order Entry 3
24 S DA(1)=$O(^ORD(101,"B",$P(X,";",3),0)) I 'DA(1) K DA Q
25 K DIC S:'$D(^ORD(101,DA(1),10,0)) ^(0)="^101.01PA^^"
26 S FHX=$O(^ORD(101,"B",$P(X,";",4),0)) I 'FHX Q
27 S FHXA=$O(^ORD(101,DA(1),10,"B",FHX,0)) I FHXA Q
28 S DIC("DR")="3///1"
29 S DIC="^ORD(101,"_DA(1)_",10,",DIC(0)="L",DLAYGO=101,X=$P(X,";",4) D ^DIC
30 K DA,DIC
31 Q
Note: See TracBrowser for help on using the repository browser.