OCXDI5 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN() ;
; Protocol Utilities
;
N OCXLINE,OCXTEXT,OCXQUIT
S OCXQUIT=0
F OCXLINE=1:1:500 S OCXTEXT=$P($T(DATA+OCXLINE),";",2,999) Q:OCXTEXT I $L(OCXTEXT) D Q:OCXQUIT
.D DOT^OCXDIAG
.S OCXTEXT=$P(OCXTEXT,";",2,999)
.S OCXQUIT=$$ADD($P(OCXTEXT,U,1),$P(OCXTEXT,U,2))
Q OCXQUIT
;
ADD(OCXX,OCXITEM) ;
;
N OCXD0,OCXD1,OCXD2,DIE,DIC,DR,X,Y,DA,OCXQUIT
S OCXD0=$$DIC("^ORD(101,",OCXX) Q:'OCXD0 0
S OCXD1=$$DIC("^ORD(101,",OCXITEM) Q:'OCXD1 0
S OCXD2=0 F S OCXD2=$O(^ORD(101,OCXD0,10,OCXD2)) Q:'OCXD2 Q:(+^ORD(101,OCXD0,10,OCXD2,0)=OCXD1)
Q:OCXD2 0 S OCXQUIT=0
I OCXFLGR W !!," '"_OCXITEM_"' is missing as an Item to the '"_OCXX_"' protocol."
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)
S:'$D(^ORD(101,OCXD0,10,0)) ^ORD(101,OCXD0,10,0)="^101.01PA^^"
S (DIE,DIC)="^ORD(101,"_OCXD0_",10,"
F DA=1:1 Q:'$D(^ORD(101,OCXD0,10,DA,0))
S DA(1)=OCXD0
S DR=".01///"_OCXITEM
S OCXSCR=1 D ^DIE
I OCXFLGR W !," added"
I 'OCXFLGR W !," '"_OCXITEM_"' added as an Item to the '"_OCXX_"' protocol"
;
Q 0
;
DIC(DIC,X) S DIC(0)="",OCXSCR=1 D ^DIC Q:(+Y>0) +Y Q 0
;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
Q:'$L($G(OCXZ0)) U
S DIR(0)=OCXZ0
S:$L($G(OCXZA)) DIR("A")=OCXZA
S:$L($G(OCXZB)) DIR("B")=OCXZB
F OCXLINE=1:1:($G(OCXZL)-1) W !
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
Q Y
;
DATA ;:
;;DGPM MOVEMENT EVENTS^OCX ORDER CHECK PATIENT MOVE.
;;PS EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
;;RA EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND RA^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND LRCH^OCX ORDER CHECK HL7 RECIEVE
;;LR7O CH EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND LRBB^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND LRAP^OCX ORDER CHECK HL7 RECIEVE
;;LR7O BB EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
;;LR7O AP EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
;;FH EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND DGPM^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND FH^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND ORG^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND PS^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND GMRA^OCX ORDER CHECK HL7 RECIEVE
;;OR EVSEND GMRC^OCX ORDER CHECK HL7 RECIEVE
;;GMRC EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
;1;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXDI5 2547 printed Apr 09, 2024@21:36:28 Page 2
OCXDI5 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;SEP 7,1999 at 10:30
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN() ;
+1 ; Protocol Utilities
+2 ;
+3 NEW OCXLINE,OCXTEXT,OCXQUIT
+4 SET OCXQUIT=0
+5 FOR OCXLINE=1:1:500
SET OCXTEXT=$PIECE($TEXT(DATA+OCXLINE),";",2,999)
if OCXTEXT
QUIT
IF $LENGTH(OCXTEXT)
Begin DoDot:1
+6 DO DOT^OCXDIAG
+7 SET OCXTEXT=$PIECE(OCXTEXT,";",2,999)
+8 SET OCXQUIT=$$ADD($PIECE(OCXTEXT,U,1),$PIECE(OCXTEXT,U,2))
End DoDot:1
if OCXQUIT
QUIT
+9 QUIT OCXQUIT
+10 ;
ADD(OCXX,OCXITEM) ;
+1 ;
+2 NEW OCXD0,OCXD1,OCXD2,DIE,DIC,DR,X,Y,DA,OCXQUIT
+3 SET OCXD0=$$DIC("^ORD(101,",OCXX)
if 'OCXD0
QUIT 0
+4 SET OCXD1=$$DIC("^ORD(101,",OCXITEM)
if 'OCXD1
QUIT 0
+5 SET OCXD2=0
FOR
SET OCXD2=$ORDER(^ORD(101,OCXD0,10,OCXD2))
if 'OCXD2
QUIT
if (+^ORD(101,OCXD0,10,OCXD2,0)=OCXD1)
QUIT
+6 if OCXD2
QUIT 0
SET OCXQUIT=0
+7 IF OCXFLGR
WRITE !!," '"_OCXITEM_"' is missing as an Item to the '"_OCXX_"' protocol."
+8 if 'OCXFLGC
QUIT 0
IF OCXFLGA
SET OCXQUIT=$$READ("Y"," Do you want to add '"_OCXITEM_"' as an Item to '"_OCXX_"' ?","YES")
IF 'OCXQUIT
QUIT (OCXQUIT[U)
+9 if '$DATA(^ORD(101,OCXD0,10,0))
SET ^ORD(101,OCXD0,10,0)="^101.01PA^^"
+10 SET (DIE,DIC)="^ORD(101,"_OCXD0_",10,"
+11 FOR DA=1:1
if '$DATA(^ORD(101,OCXD0,10,DA,0))
QUIT
+12 SET DA(1)=OCXD0
+13 SET DR=".01///"_OCXITEM
+14 SET OCXSCR=1
DO ^DIE
+15 IF OCXFLGR
WRITE !," added"
+16 IF 'OCXFLGR
WRITE !," '"_OCXITEM_"' added as an Item to the '"_OCXX_"' protocol"
+17 ;
+18 QUIT 0
+19 ;
DIC(DIC,X) SET DIC(0)=""
SET OCXSCR=1
DO ^DIC
if (+Y>0)
QUIT +Y
QUIT 0
+1 ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
+1 NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 if '$LENGTH($GET(OCXZ0))
QUIT U
+3 SET DIR(0)=OCXZ0
+4 if $LENGTH($GET(OCXZA))
SET DIR("A")=OCXZA
+5 if $LENGTH($GET(OCXZB))
SET DIR("B")=OCXZB
+6 FOR OCXLINE=1:1:($GET(OCXZL)-1)
WRITE !
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT U
+9 QUIT Y
+10 ;
DATA ;:
+1 ;;DGPM MOVEMENT EVENTS^OCX ORDER CHECK PATIENT MOVE.
+2 ;;PS EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
+3 ;;RA EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
+4 ;;OR EVSEND RA^OCX ORDER CHECK HL7 RECIEVE
+5 ;;OR EVSEND LRCH^OCX ORDER CHECK HL7 RECIEVE
+6 ;;LR7O CH EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
+7 ;;OR EVSEND LRBB^OCX ORDER CHECK HL7 RECIEVE
+8 ;;OR EVSEND LRAP^OCX ORDER CHECK HL7 RECIEVE
+9 ;;LR7O BB EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
+10 ;;LR7O AP EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
+11 ;;FH EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
+12 ;;OR EVSEND DGPM^OCX ORDER CHECK HL7 RECIEVE
+13 ;;OR EVSEND FH^OCX ORDER CHECK HL7 RECIEVE
+14 ;;OR EVSEND ORG^OCX ORDER CHECK HL7 RECIEVE
+15 ;;OR EVSEND PS^OCX ORDER CHECK HL7 RECIEVE
+16 ;;OR EVSEND GMRA^OCX ORDER CHECK HL7 RECIEVE
+17 ;;OR EVSEND GMRC^OCX ORDER CHECK HL7 RECIEVE
+18 ;;GMRC EVSEND OR^OCX ORDER CHECK HL7 RECIEVE
+19 ;1;
