OCXOHL7.m

OCXOHL7 ;SLC/RJS,CLA - External Interface - PROCESS HL7 DATA ARRAY ;4/02/03  13:50

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,179**;Dec 17,1997

 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 ;

 ;

 Q

SILENT(OCXMSG,OUTMSG) ;

 ;

 N OCXSEG0,OCXRDT,OCXHL7,OCXOZZT

 S OCXRDT=($H*86400+$P($H,",",2))

 S:'$D(OUTMSG) OUTMSG=""

 D CHECK(.OCXMSG,.OUTMSG)

 Q

 ;

VERBOSE(OCXMSG) ;

 ;

 N OCXSEG0,OCXX,OUTMSG,OCXHL7,OCXOZZT

 S OCXRDT=($H*86400+$P($H,",",2))

 S OUTMSG=""

 D CHECK(.OCXMSG,.OUTMSG)

 W:$O(OUTMSG(0)) !,"Order Check Message: ",$C(7)

 S OCXX=0 F  S OCXX=$O(OUTMSG(OCXX)) Q:'OCXX  W !,OUTMSG(OCXX)

 W:$O(OUTMSG(0)) !,$C(7)

 Q

 ;

CHECK(OCXMSG,OUTMSG) ;

 ;

 N OCXARY,OCXDFN,OCXEL,OCXODATA,OCXOLOG,OCXOSRC,OCXDSIZE

 N OCXOTIME,OCXQUIT,OCXSEG0,OCXSEQ,OCXSUB,OCXTEST,OCXVAR

 ;

 I $$RTEST D  Q

 .N OMSG,OTMOUT,OCXM

 .S OMSG="^25^^Order Checking is recompiling and momentarily disabled"

 .S OCXM=0 F  S OCXM=$O(OUTMSG(OCXM)) Q:'OCXM  Q:(OUTMSG(OCXM)[OMSG)

 .Q:OCXM

 .S OUTMSG($O(OUTMSG(""),-1)+1)=OMSG

 ;

 S OCXARY=$S($L($G(OCXMSG)):OCXMSG,1:"OCXMSG") Q:'$O(@OCXARY@(0))

 ;

 S (OCXQUIT,OCXSUB)=0 F  S OCXSUB=$O(@OCXARY@(OCXSUB)) Q:'OCXSUB  I ($P($G(@OCXARY@(OCXSUB)),"|",1)="ORC") D  Q

 .S:($P($P($G(@OCXARY@(OCXSUB)),"|",2),"^",1)="ZC") OCXQUIT=1

 ;

 Q:OCXQUIT

 ;

 S OCXOLOG=$$LOG(OCXARY)

 ;

 S OCXODATA="",OCXTEST=$G(OCXOVRD)

 ;

 S OCXVAR("DUZ")=""

 S OCXVAR("OCXMSG")=""

 S OCXVAR("OCXARY")=""

 S OCXOSRC="GENERIC HL7 MESSAGE ARRAY"

 ;

 S OCXSUB=0 F  S OCXSUB=$O(@OCXARY@(OCXSUB)) Q:'OCXSUB  D

 .N OCXLINE,OCXPC,X,OCXTDAT,OCXCLIN,LASTPC

 .S OCXDSIZE=$$ARYSIZE($NAME(@OCXARY@(OCXSUB)))

 .;

 .I (OCXDSIZE<5000) D  Q:'$L($G(OCXLINE(0)))

 ..M OCXLINE(0)=@OCXARY@(OCXSUB)

 ..S OCXLINE(0,0)=OCXLINE(0)  ;  This will make first node consistent with continuation lines.

 ..S OCXSEG=$P($G(OCXLINE(0)),"|",1)

 .;

 .I (OCXDSIZE>4999) D  Q:'$L($G(^TMP($J,"OCXLDATA",0)))

 ..K ^TMP($J,"OCXLDATA")

 ..M ^TMP($J,"OCXLDATA",0)=@OCXARY@(OCXSUB)

 ..S ^TMP($J,"OCXLDATA",0,0)=^TMP($J,"OCXLDATA",0)  ;  This will make first node consistent with continuation lines.

 ..S OCXSEG=$P($G(^TMP($J,"OCXLDATA",0)),"|",1)

 .;

 .Q:'$L(OCXSEG)

 .;

 .I $D(OCXODATA(OCXSEG)) D   ;  This is another instance of this segment.

 ..;                            Process current OCXODATA and reset OCXODATA for this new instance.

 ..; Process OCXODATA

 ..S OCXDFN=$$GETDFN(OCXARY) I $G(OCXDFN) D UPDATE^OCXOZ01(+OCXDFN,OCXOSRC,.OUTMSG)

 ..;

 ..; Reset OCXODATA

 ..S OCXSEQ=+$G(OCXODATA(OCXSEG)) F  Q:'OCXSEQ  D  S OCXSEQ=$O(OCXODATA(OCXSEQ))

 ...S OCXSEG0=$G(OCXODATA(OCXSEQ)) Q:'$L(OCXSEG0)

 ...K OCXODATA(OCXSEQ),OCXODATA(OCXSEG0)

 .;

 .S OCXODATA(OCXSUB)=OCXSEG    ;  Set OCXODATA 'cross reference'

 .S OCXODATA(OCXSEG)=OCXSUB    ;  Set OCXODATA 'cross reference'

 .;

 .;  Load this segment instance into OCXODATA

 .;

 .;  OCXPC - Keeps track of which "|" piece we're on

 .;

 .I (OCXDSIZE<5000) D LOADATA(OCXSEG,"OCXLINE(0)")

 .;

 .I (OCXDSIZE>4999) D LOADATA(OCXSEG,$NAME(^TMP($J,"OCXLDATA",0)))

 ;

 S OCXDFN=$$GETDFN(OCXARY)

 I $G(OCXDFN) D UPDATE^OCXOZ01(+OCXDFN,OCXOSRC,.OUTMSG) I 1  ; Process OCXODATA for the last segment

 ;

 D FINISH^OCXOLOG(OCXOLOG)

 ;

 K ^TMP($J,"OCXLDATA")

 ;

 Q

 ;

LOADATA(OCXSEG,OCXSD) ; Get '|' piece #OCXPC of OCXSD Segment Data array.

 ;

 N OCXTEXT,OCXPCNT,OCXD0,OCXD1

 ;

 Q:'$L(OCXSEG)

 S OCXPCNT=0,OCXD0="" F  S OCXD0=$O(@OCXSD@(OCXD0)) Q:'$L(OCXD0)  D

 .S OCXTEXT=$G(@OCXSD@(OCXD0))

 .F OCXD1=1:1:$L(OCXTEXT) D

 ..I ($E(OCXTEXT,OCXD1)="|") S OCXPCNT=OCXPCNT+1 Q

 ..I ($L($G(OCXODATA(OCXSEG,OCXPCNT)))<241) S OCXODATA(OCXSEG,OCXPCNT)=$G(OCXODATA(OCXSEG,OCXPCNT))_$E(OCXTEXT,OCXD1)

 ;

 Q

 ;

RTEST() ; Does ^OCXOZ01 exist ??  Is it currently being compiled ??

 N DATE,TMOUT

 Q:'$L($T(^OCXOZ01)) 1

 I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"

 S DATE=$P($G(^OCXD(861,1,0)),U,3)

 I DATE,((+DATE)=(+$H)),(((+$P($H,",",2))-(+$P(DATE,",",2)))<1800) Q 1

 Q 0

 ;

LOG(OCXARY) ;

 ;   Log Data Messages

 ;

 I $G(OCXTRACE),$$CDATA^OCXOZ01 W:$G(OCXTRACE) !,"  Raw Input Data: ",! D ZW(OCXARY) Q 0

 Q:'$L($T(LOG^OCXOZ01)) 0 Q:'$$LOG^OCXOZ01 0

 N OCXDFN,OCXNL

 I '$O(@OCXARY@(0)) S OCXARY="OCXNL",OCXNL(1)="Null HL7 Data Array Found"

 S OCXDFN=$$GETDFN(OCXARY)

 Q $$NEW^OCXOLOG(OCXARY,"HL7",+$G(DUZ),+OCXDFN)

 ;

ARYSIZE(ARY) ; Get array size (Local or Global)

 ;

 N ARY1,SIZE

 ;

 S SIZE=0

 ;

 I '(ARY["^") F  S ARY=$Q(@ARY) Q:'$L(ARY)  S SIZE=SIZE+$L(@ARY)

 ;

 I (ARY["^") D

 .S ARY=$NAME(@ARY),ARY1=ARY

 .S:($E(ARY,$L(ARY))=")") ARY=$E(ARY,1,$L(ARY)-1)_","

 .F  S ARY1=$Q(@ARY1) Q:'$L(ARY1)  Q:'(ARY1[ARY)  S SIZE=SIZE+$L(@ARY1)

 ;

 Q SIZE

 ;

ZW(ARY) ; ZWrite an array (Local or Global)

 ;

 N ARY1

 ;

 I '(ARY["^") D  Q

 .F  S ARY=$Q(@ARY) Q:'$L(ARY)  W !,ARY," = ",@ARY

 ;

 I (ARY["^") D  Q

 .S ARY=$NAME(@ARY),ARY1=ARY

 .S:($E(ARY,$L(ARY))=")") ARY=$E(ARY,1,$L(ARY)-1)_","

 .F  S ARY1=$Q(@ARY1) Q:'$L(ARY1)  Q:'(ARY1[ARY)  W !,ARY1," = ",@ARY1

 ;

 Q

 ;

ERROR Q

 ;

 ; **** Old Labels to insure backwards compatibility ****

 ;

 ;

GETDFN(ARRAY) ;   Returns the patient IEN from file 2.

 ;

 N OCXNDX,OCXARY,OCXP1,OCXP2,OCXP3

 S OCXARY=$S($L($G(ARRAY)):ARRAY,1:"ARRAY")

 S OCXNDX=0 F  S OCXNDX=$O(@OCXARY@(OCXNDX)) Q:'OCXNDX  I $P($G(@OCXARY@(OCXNDX)),"|",1)="PID" Q

 Q:'OCXNDX 0

 ;

 S OCXP1=$P($G(@OCXARY@(OCXNDX)),"|",4)

 S OCXP2=$P($G(@OCXARY@(OCXNDX)),"|",5)

 S OCXP3=$P($G(@OCXARY@(OCXNDX)),"|",6)

 ;

 Q:(OCXP2["DPT(") +OCXP2

 ;

 I $L(OCXP3),($P($G(^DPT(+OCXP1,0)),U,1)=OCXP3) Q +OCXP1

 ;

 Q 0

 ;

 ;  Old line label area.

 ;

PROC(OCXMSG,OUTMSG) ;

 D SILENT(.OCXMSG,.OUTMSG)

 Q

 ;

EN(OCXMSG) ;

 D VERBOSE(.OCXMSG)

 Q

 ;

OCXOHL7   ;SLC/RJS,CLA - External Interface - PROCESS HL7 DATA ARRAY ;4/02/03  13:50

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,179**;Dec 17,1997

 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 +3       ;

 +4       ;

 +5        QUIT 

SILENT(OCXMSG,OUTMSG) ;

 +1       ;

 +2        NEW OCXSEG0,OCXRDT,OCXHL7,OCXOZZT

 +3        SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))

 +4        IF '$DATA(OUTMSG)

               SET OUTMSG=""

 +5        DO CHECK(.OCXMSG,.OUTMSG)

 +6        QUIT 

 +7       ;

VERBOSE(OCXMSG) ;

 +1       ;

 +2        NEW OCXSEG0,OCXX,OUTMSG,OCXHL7,OCXOZZT

 +3        SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))

 +4        SET OUTMSG=""

 +5        DO CHECK(.OCXMSG,.OUTMSG)

 +6        IF $ORDER(OUTMSG(0))

               WRITE !,"Order Check Message: ",$CHAR(7)

 +7        SET OCXX=0

           FOR 

               SET OCXX=$ORDER(OUTMSG(OCXX))

               IF 'OCXX

                   QUIT 

               WRITE !,OUTMSG(OCXX)

 +8        IF $ORDER(OUTMSG(0))

               WRITE !,$CHAR(7)

 +9        QUIT 

 +10      ;

CHECK(OCXMSG,OUTMSG) ;

 +1       ;

 +2        NEW OCXARY,OCXDFN,OCXEL,OCXODATA,OCXOLOG,OCXOSRC,OCXDSIZE

 +3        NEW OCXOTIME,OCXQUIT,OCXSEG0,OCXSEQ,OCXSUB,OCXTEST,OCXVAR

 +4       ;

 +5        IF $$RTEST

               Begin DoDot:1

 +6                NEW OMSG,OTMOUT,OCXM

 +7                SET OMSG="^25^^Order Checking is recompiling and momentarily disabled"

 +8                SET OCXM=0

                   FOR 

                       SET OCXM=$ORDER(OUTMSG(OCXM))

                       IF 'OCXM

                           QUIT 

                       IF (OUTMSG(OCXM)[OMSG)

                           QUIT 

 +9                IF OCXM

                       QUIT 

 +10               SET OUTMSG($ORDER(OUTMSG(""),-1)+1)=OMSG

               End DoDot:1

               QUIT 

 +11      ;

 +12       SET OCXARY=$SELECT($LENGTH($GET(OCXMSG)):OCXMSG,1:"OCXMSG")

           IF '$ORDER(@OCXARY@(0))

               QUIT 

 +13      ;

 +14       SET (OCXQUIT,OCXSUB)=0

           FOR 

               SET OCXSUB=$ORDER(@OCXARY@(OCXSUB))

               IF 'OCXSUB

                   QUIT 

               IF ($PIECE($GET(@OCXARY@(OCXSUB)),"|",1)="ORC")

                   Begin DoDot:1

 +15                   IF ($PIECE($PIECE($GET(@OCXARY@(OCXSUB)),"|",2),"^",1)="ZC")

                           SET OCXQUIT=1

                   End DoDot:1

                   QUIT 

 +16      ;

 +17       IF OCXQUIT

               QUIT 

 +18      ;

 +19       SET OCXOLOG=$$LOG(OCXARY)

 +20      ;

 +21       SET OCXODATA=""

           SET OCXTEST=$GET(OCXOVRD)

 +22      ;

 +23       SET OCXVAR("DUZ")=""

 +24       SET OCXVAR("OCXMSG")=""

 +25       SET OCXVAR("OCXARY")=""

 +26       SET OCXOSRC="GENERIC HL7 MESSAGE ARRAY"

 +27      ;

 +28       SET OCXSUB=0

           FOR 

               SET OCXSUB=$ORDER(@OCXARY@(OCXSUB))

               IF 'OCXSUB

                   QUIT 

               Begin DoDot:1

 +29               NEW OCXLINE,OCXPC,X,OCXTDAT,OCXCLIN,LASTPC

 +30               SET OCXDSIZE=$$ARYSIZE($NAME(@OCXARY@(OCXSUB)))

 +31      ;

 +32               IF (OCXDSIZE<5000)

                       Begin DoDot:2

 +33                       MERGE OCXLINE(0)=@OCXARY@(OCXSUB)

 +34      ;  This will make first node consistent with continuation lines.

                           SET OCXLINE(0,0)=OCXLINE(0)

 +35                       SET OCXSEG=$PIECE($GET(OCXLINE(0)),"|",1)

                       End DoDot:2

                       IF '$LENGTH($GET(OCXLINE(0)))

                           QUIT 

 +36      ;

 +37               IF (OCXDSIZE>4999)

                       Begin DoDot:2

 +38                       KILL ^TMP($JOB,"OCXLDATA")

 +39                       MERGE ^TMP($JOB,"OCXLDATA",0)=@OCXARY@(OCXSUB)

 +40      ;  This will make first node consistent with continuation lines.

                           SET ^TMP($JOB,"OCXLDATA",0,0)=^TMP($JOB,"OCXLDATA",0)

 +41                       SET OCXSEG=$PIECE($GET(^TMP($JOB,"OCXLDATA",0)),"|",1)

                       End DoDot:2

                       IF '$LENGTH($GET(^TMP($JOB,"OCXLDATA",0)))

                           QUIT 

 +42      ;

 +43               IF '$LENGTH(OCXSEG)

                       QUIT 

 +44      ;

 +45      ;  This is another instance of this segment.

                   IF $DATA(OCXODATA(OCXSEG))

                       Begin DoDot:2

 +46      ;                            Process current OCXODATA and reset OCXODATA for this new instance.

 +47      ; Process OCXODATA

 +48                       SET OCXDFN=$$GETDFN(OCXARY)

                           IF $GET(OCXDFN)

                               DO UPDATE^OCXOZ01(+OCXDFN,OCXOSRC,.OUTMSG)

 +49      ;

 +50      ; Reset OCXODATA

 +51                       SET OCXSEQ=+$GET(OCXODATA(OCXSEG))

                           FOR 

                               IF 'OCXSEQ

                                   QUIT 

                               Begin DoDot:3

 +52                               SET OCXSEG0=$GET(OCXODATA(OCXSEQ))

                                   IF '$LENGTH(OCXSEG0)

                                       QUIT 

 +53                               KILL OCXODATA(OCXSEQ),OCXODATA(OCXSEG0)

                               End DoDot:3

                               SET OCXSEQ=$ORDER(OCXODATA(OCXSEQ))

                       End DoDot:2

 +54      ;

 +55      ;  Set OCXODATA 'cross reference'

                   SET OCXODATA(OCXSUB)=OCXSEG

 +56      ;  Set OCXODATA 'cross reference'

                   SET OCXODATA(OCXSEG)=OCXSUB

 +57      ;

 +58      ;  Load this segment instance into OCXODATA

 +59      ;

 +60      ;  OCXPC - Keeps track of which "|" piece we're on

 +61      ;

 +62               IF (OCXDSIZE<5000)

                       DO LOADATA(OCXSEG,"OCXLINE(0)")

 +63      ;

 +64               IF (OCXDSIZE>4999)

                       DO LOADATA(OCXSEG,$NAME(^TMP($JOB,"OCXLDATA",0)))

               End DoDot:1

 +65      ;

 +66       SET OCXDFN=$$GETDFN(OCXARY)

 +67      ; Process OCXODATA for the last segment

           IF $GET(OCXDFN)

               DO UPDATE^OCXOZ01(+OCXDFN,OCXOSRC,.OUTMSG)

               IF 1

 +68      ;

 +69       DO FINISH^OCXOLOG(OCXOLOG)

 +70      ;

 +71       KILL ^TMP($JOB,"OCXLDATA")

 +72      ;

 +73       QUIT 

 +74      ;

LOADATA(OCXSEG,OCXSD) ; Get '|' piece #OCXPC of OCXSD Segment Data array.

 +1       ;

 +2        NEW OCXTEXT,OCXPCNT,OCXD0,OCXD1

 +3       ;

 +4        IF '$LENGTH(OCXSEG)

               QUIT 

 +5        SET OCXPCNT=0

           SET OCXD0=""

           FOR 

               SET OCXD0=$ORDER(@OCXSD@(OCXD0))

               IF '$LENGTH(OCXD0)

                   QUIT 

               Begin DoDot:1

 +6                SET OCXTEXT=$GET(@OCXSD@(OCXD0))

 +7                FOR OCXD1=1:1:$LENGTH(OCXTEXT)

                       Begin DoDot:2

 +8                        IF ($EXTRACT(OCXTEXT,OCXD1)="|")

                               SET OCXPCNT=OCXPCNT+1

                               QUIT 

 +9                        IF ($LENGTH($GET(OCXODATA(OCXSEG,OCXPCNT)))<241)

                               SET OCXODATA(OCXSEG,OCXPCNT)=$GET(OCXODATA(OCXSEG,OCXPCNT))_$EXTRACT(OCXTEXT,OCXD1)

                       End DoDot:2

               End DoDot:1

 +10      ;

 +11       QUIT 

 +12      ;

RTEST()   ; Does ^OCXOZ01 exist ??  Is it currently being compiled ??

 +1        NEW DATE,TMOUT

 +2        IF '$LENGTH($TEXT(^OCXOZ01))

               QUIT 1

 +3        IF '($PIECE($GET(^OCXD(861,1,0)),U,1)="SITE PREFERENCES")

               KILL ^OCXD(861,1)

               SET ^OCXD(861,1,0)="SITE PREFERENCES"

 +4        SET DATE=$PIECE($GET(^OCXD(861,1,0)),U,3)

 +5        IF DATE

               IF ((+DATE)=(+$HOROLOG))

                   IF (((+$PIECE($HOROLOG,",",2))-(+$PIECE(DATE,",",2)))<1800)

                       QUIT 1

 +6        QUIT 0

 +7       ;

LOG(OCXARY) ;

 +1       ;   Log Data Messages

 +2       ;

 +3        IF $GET(OCXTRACE)

               IF $$CDATA^OCXOZ01

                   IF $GET(OCXTRACE)

                       WRITE !,"  Raw Input Data: ",!

                   DO ZW(OCXARY)

                   QUIT 0

 +4        IF '$LENGTH($TEXT(LOG^OCXOZ01))

               QUIT 0

           IF '$$LOG^OCXOZ01

               QUIT 0

 +5        NEW OCXDFN,OCXNL

 +6        IF '$ORDER(@OCXARY@(0))

               SET OCXARY="OCXNL"

               SET OCXNL(1)="Null HL7 Data Array Found"

 +7        SET OCXDFN=$$GETDFN(OCXARY)

 +8        QUIT $$NEW^OCXOLOG(OCXARY,"HL7",+$GET(DUZ),+OCXDFN)

 +9       ;

ARYSIZE(ARY) ; Get array size (Local or Global)

 +1       ;

 +2        NEW ARY1,SIZE

 +3       ;

 +4        SET SIZE=0

 +5       ;

 +6        IF '(ARY["^")

               FOR 

                   SET ARY=$QUERY(@ARY)

                   IF '$LENGTH(ARY)

                       QUIT 

                   SET SIZE=SIZE+$LENGTH(@ARY)

 +7       ;

 +8        IF (ARY["^")

               Begin DoDot:1

 +9                SET ARY=$NAME(@ARY)

                   SET ARY1=ARY

 +10               IF ($EXTRACT(ARY,$LENGTH(ARY))=")")

                       SET ARY=$EXTRACT(ARY,1,$LENGTH(ARY)-1)_","

 +11               FOR 

                       SET ARY1=$QUERY(@ARY1)

                       IF '$LENGTH(ARY1)

                           QUIT 

                       IF '(ARY1[ARY)

                           QUIT 

                       SET SIZE=SIZE+$LENGTH(@ARY1)

               End DoDot:1

 +12      ;

 +13       QUIT SIZE

 +14      ;

ZW(ARY)   ; ZWrite an array (Local or Global)

 +1       ;

 +2        NEW ARY1

 +3       ;

 +4        IF '(ARY["^")

               Begin DoDot:1

 +5                FOR 

                       SET ARY=$QUERY(@ARY)

                       IF '$LENGTH(ARY)

                           QUIT 

                       WRITE !,ARY," = ",@ARY

               End DoDot:1

               QUIT 

 +6       ;

 +7        IF (ARY["^")

               Begin DoDot:1

 +8                SET ARY=$NAME(@ARY)

                   SET ARY1=ARY

 +9                IF ($EXTRACT(ARY,$LENGTH(ARY))=")")

                       SET ARY=$EXTRACT(ARY,1,$LENGTH(ARY)-1)_","

 +10               FOR 

                       SET ARY1=$QUERY(@ARY1)

                       IF '$LENGTH(ARY1)

                           QUIT 

                       IF '(ARY1[ARY)

                           QUIT 

                       WRITE !,ARY1," = ",@ARY1

               End DoDot:1

               QUIT 

 +11      ;

 +12       QUIT 

 +13      ;

ERROR      QUIT 

 +1       ;

 +2       ; **** Old Labels to insure backwards compatibility ****

 +3       ;

 +4       ;

GETDFN(ARRAY) ;   Returns the patient IEN from file 2.

 +1       ;

 +2        NEW OCXNDX,OCXARY,OCXP1,OCXP2,OCXP3

 +3        SET OCXARY=$SELECT($LENGTH($GET(ARRAY)):ARRAY,1:"ARRAY")

 +4        SET OCXNDX=0

           FOR 

               SET OCXNDX=$ORDER(@OCXARY@(OCXNDX))

               IF 'OCXNDX

                   QUIT 

               IF $PIECE($GET(@OCXARY@(OCXNDX)),"|",1)="PID"

                   QUIT 

 +5        IF 'OCXNDX

               QUIT 0

 +6       ;

 +7        SET OCXP1=$PIECE($GET(@OCXARY@(OCXNDX)),"|",4)

 +8        SET OCXP2=$PIECE($GET(@OCXARY@(OCXNDX)),"|",5)

 +9        SET OCXP3=$PIECE($GET(@OCXARY@(OCXNDX)),"|",6)

 +10      ;

 +11       IF (OCXP2["DPT(")

               QUIT +OCXP2

 +12      ;

 +13       IF $LENGTH(OCXP3)

               IF ($PIECE($GET(^DPT(+OCXP1,0)),U,1)=OCXP3)

                   QUIT +OCXP1

 +14      ;

 +15       QUIT 0

 +16      ;

 +17      ;  Old line label area.

 +18      ;

PROC(OCXMSG,OUTMSG) ;

 +1        DO SILENT(.OCXMSG,.OUTMSG)

 +2        QUIT 

 +3       ;

EN(OCXMSG) ;

 +1        DO VERBOSE(.OCXMSG)

 +2        QUIT 

 +3       ;