[613] | 1 | OCXDI5 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
---|
| 3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
| 4 | ;
|
---|
| 5 | EN() ;
|
---|
| 6 | ; Protocol Utilities
|
---|
| 7 | ;
|
---|
| 8 | N OCXLINE,OCXTEXT,OCXQUIT
|
---|
| 9 | S OCXQUIT=0
|
---|
| 10 | F OCXLINE=1:1:500 S OCXTEXT=$P($T(DATA+OCXLINE),";",2,999) Q:OCXTEXT I $L(OCXTEXT) D Q:OCXQUIT
|
---|
| 11 | .D DOT^OCXDIAG
|
---|
| 12 | .S OCXTEXT=$P(OCXTEXT,";",2,999)
|
---|
| 13 | .S OCXQUIT=$$ADD($P(OCXTEXT,U,1),$P(OCXTEXT,U,2))
|
---|
| 14 | Q OCXQUIT
|
---|
| 15 | ;
|
---|
| 16 | ADD(OCXX,OCXITEM) ;
|
---|
| 17 | ;
|
---|
| 18 | N OCXD0,OCXD1,OCXD2,DIE,DIC,DR,X,Y,DA,OCXQUIT
|
---|
| 19 | S OCXD0=$$DIC("^ORD(101,",OCXX) Q:'OCXD0 0
|
---|
| 20 | S OCXD1=$$DIC("^ORD(101,",OCXITEM) Q:'OCXD1 0
|
---|
| 21 | S OCXD2=0 F S OCXD2=$O(^ORD(101,OCXD0,10,OCXD2)) Q:'OCXD2 Q:(+^ORD(101,OCXD0,10,OCXD2,0)=OCXD1)
|
---|
| 22 | Q:OCXD2 0 S OCXQUIT=0
|
---|
| 23 | I OCXFLGR W !!," '"_OCXITEM_"' is missing as an Item to the '"_OCXX_"' protocol."
|
---|
| 24 | Q:'OCXFLGC 0 I OCXFLGA S OCXQUIT=$$READ("Y"," Do you want to add '"_OCXITEM_"' as an Item to '"_OCXX_"' ?","YES") I 'OCXQUIT Q (OCXQUIT[U)
|
---|
| 25 | S:'$D(^ORD(101,OCXD0,10,0)) ^ORD(101,OCXD0,10,0)="^101.01PA^^"
|
---|
| 26 | S (DIE,DIC)="^ORD(101,"_OCXD0_",10,"
|
---|
| 27 | F DA=1:1 Q:'$D(^ORD(101,OCXD0,10,DA,0))
|
---|
| 28 | S DA(1)=OCXD0
|
---|
| 29 | S DR=".01///"_OCXITEM
|
---|
| 30 | S OCXSCR=1 D ^DIE
|
---|
| 31 | I OCXFLGR W !," added"
|
---|
| 32 | I 'OCXFLGR W !," '"_OCXITEM_"' added as an Item to the '"_OCXX_"' protocol"
|
---|
| 33 | ;
|
---|
| 34 | Q 0
|
---|
| 35 | ;
|
---|
| 36 | DIC(DIC,X) S DIC(0)="",OCXSCR=1 D ^DIC Q:(+Y>0) +Y Q 0
|
---|
| 37 | ;
|
---|
| 38 | READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
|
---|
| 39 | N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
|
---|
| 40 | Q:'$L($G(OCXZ0)) U
|
---|
| 41 | S DIR(0)=OCXZ0
|
---|
| 42 | S:$L($G(OCXZA)) DIR("A")=OCXZA
|
---|
| 43 | S:$L($G(OCXZB)) DIR("B")=OCXZB
|
---|
| 44 | F OCXLINE=1:1:($G(OCXZL)-1) W !
|
---|
| 45 | D ^DIR
|
---|
| 46 | I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
|
---|
| 47 | Q Y
|
---|
| 48 | ;
|
---|
| 49 | DATA ;:
|
---|
| 50 | ;;DGPM MOVEMENT EVENTS^OCX ORDER CHECK PATIENT MOVE.
|
---|
| 51 | ;;PS EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 52 | ;;RA EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 53 | ;;OR EVSEND RA^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 54 | ;;OR EVSEND LRCH^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 55 | ;;LR7O CH EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 56 | ;;OR EVSEND LRBB^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 57 | ;;OR EVSEND LRAP^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 58 | ;;LR7O BB EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 59 | ;;LR7O AP EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 60 | ;;FH EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 61 | ;;OR EVSEND DGPM^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 62 | ;;OR EVSEND FH^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 63 | ;;OR EVSEND ORG^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 64 | ;;OR EVSEND PS^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 65 | ;;OR EVSEND GMRA^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 66 | ;;OR EVSEND GMRC^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 67 | ;;GMRC EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
|
---|
| 68 | ;1;
|
---|