- 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;
- 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;
