ORY2211 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*221) ;AUG 30,2005 at 11:41
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**221**;Dec 17,1997
 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 ;
S ;
 ;
 Q
 ;
 ;
COMPARE(L,R) ;
 ;
 Q:$$RES("R") 1
 ;
 Q:'$L($O(L(""))) $$ADDREC^ORY2212("R")
 ;
 N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)
 ;
 Q 0
 ;
RES(REF) ;
 ;
 N QUIT,SUB
 S QUIT=0
 S SUB="" F  S SUB=$O(@REF@(SUB)) Q:'$L(SUB)  I (SUB[":") D  Q:QUIT
 .N DD,DA
 .S DD=$P(SUB,":",1),DA=$P(SUB,":",2)
 .I $L(DA),'(DA=+DA) D  Q:QUIT
 ..N DANEW,SUBNEW
 ..S DANEW=$O(^OCXS($P(DA,U,2),"B",$P(DA,U,1),0))
 ..I 'DANEW W !!,$P($G(^OCXS(+$P(DA,U,2),0)),U,1),": ",$P(DA,U,1),"  could not resolve name.",!!,"    End Transport." S QUIT=1 Q
 ..S SUBNEW=DD_":"_DANEW
 ..I $D(@REF@(SUBNEW)) W !!," multiple #",DANEW," already existed." S QUIT=1 Q
 ..M @REF@(SUBNEW)=@REF@(SUB)
 ..K @REF@(SUB)
 ..S SUB=""
 .I $L(SUB),($D(@REF@(SUB))>9) S QUIT=$$RES($NA(@REF@(SUB)))
 ;
 Q QUIT
 ;
MULT(CREF,OCXDD) ;
 ;
 N OCXSUB,LREF,RREF,QUIT,OCXFLD
 S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))
 ;
 S QUIT=0,OCXFLD="" F  S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD)  D  Q:QUIT
 .I (OCXFLD[":") D  Q:QUIT
 ..Q:$$EXFLD(+OCXFLD,0)
 ..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D  M @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
 ...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
 ...S QUIT=$$ADDMULT^ORY2213(CREF,OCXDD,OCXFLD)
 ..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D  M @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
 ...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
 ...S QUIT=$$DELMULT^ORY2213($$APPEND(CREF,OCXDD),OCXFLD)
 .;
 .I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D
 ..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D  Q
 ...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E"))) D  Q
 ....D WARN("Data Value Missing in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
 ....S QUIT=$$EDITFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
 ...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E"))) D  Q
 ....D WARN("Extra Data Value in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
 ....S QUIT=$$DELFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
 ...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D
 ....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
 ....S QUIT=$$EDITFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
 ..S OCXSUB=0 F  Q:QUIT  S OCXSUB=$O(@CREF@(OCXDD,OCXFLD,OCXSUB)) Q:'OCXSUB  I '($G(@RREF@(OCXDD,OCXFLD,OCXSUB))=$G(@LREF@(OCXDD,OCXFLD,OCXSUB))) D  Q
 ...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
 ...S QUIT=$$LOADWORD^ORY2212(RREF,OCXDD,OCXFLD,OCXSUB)
 .;
 .I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
 Q QUIT
 ;
APPEND(ARRAY,OCXSUB) ;
 S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""
 Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"
 Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"
 ;
EXFLD(FILE,OCXFLD) ;
 N OCXFNAM
 S OCXFNAM=$$FIELD^OCXSENDD(FILE,OCXFLD,"LABEL")
 I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1
 I (FILE=860.2),(OCXFLD=.02) Q 1
 I (FILE=860.22),(OCXFLD=4) Q 1
 I (FILE=860.3),(OCXFLD=3) Q 1
 I (FILE=860.9),(OCXFLD=1) Q 1
 I (FILE=860.91) Q 1
 I (FILE=860.801) Q 1
 I (FILE=860.81) Q 1
 I (FILE=861.01) Q 1
 I (FILE=863.02) Q 1
 I (FILE=863.54) Q 1
 I (FILE=863.61) Q 1
 I (FILE=863.72) Q 1
 I (FILE=863.81) Q 1
 I ($E(OCXFNAM,1)="*") Q 1
 Q 0
 ;
WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
 ;
 Q:$G(OCXAUTO)
 ;
 N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
 ;
 S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"
 W !!,"------------",MSG,DASH
 D DSPHDR(CREF,OCXDD,OCXFLD)
 I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
 I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)
 ;
 W ! Q
 ;
DSPREC(CREF,OCXDD,OCXFLD) ;
 ;
 N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
 S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
 S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")
 S OCXSUB="" F  S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB)  D
 .;
 .I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D
 ..N LINE
 ..Q:$$EXFLD(+OCXFLD,OCXSUB)
 ..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXSENDD(+OCXFLD,OCXSUB,"LABEL"),": ",$G(@OCXCREF@(OCXSUB,"E"))
 ..S LINE=0 F  S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE  D
 ...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
 .;
 .I (OCXSUB[":") D
 ..N D0,OCXDD,FILENAME
 ..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB
 ..S FILENAME=$$FILENAME^OCXSENDD(OCXDD)
 ..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME
 ..E  W !!,?(5+(LEVL*4)),FILENAME
 ..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))
 ..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
 ;
 Q
 ;
DSPHDR(CREF,OCXDD,OCXFLD) ;
 ;
 N D0,FILE,FILEID,OCXPTR,OCXDDPTH
 S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
 S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D
 .N OCXDD,D0,FILEID
 .S FILEID=$P(OCXDDPTH,",",OCXPTR)
 .I (FILEID[":") D
 ..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))
 ..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXSENDD(OCXDD)
 ..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID
 ..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
 ..E  I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")") W:D0 " [",D0,"]"
 ;
 Q
 ;
DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
 ;
 N OCXDPTR,LREF,RREF,OCXDDPTH
 ;
 S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)
 S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"
 W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXSENDD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
 I OCXSUB W " Line #",OCXSUB
 ;
 W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) DEVCUR.FO-SLC.DOMAIN.EXT: ",@RREF@(OCXFLD,OCXSUB)
 W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$NETNAME^OCXSEND,": ",@LREF@(OCXFLD,OCXSUB)
 ;
 Q
 ;
 W !,?10 Q 0 Q $$PAUSE
 ;
PAUSE() W "  Press Enter " R X:DTIME W ! Q (X[U)
 ;
NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXSENDD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY2211   6006     printed  Sep 23, 2025@20:15:48                                                                                                                                                                                                     Page 2
ORY2211   ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*221) ;AUG 30,2005 at 11:41
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**221**;Dec 17,1997
 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 +3       ;
S         ;
 +1       ;
 +2        QUIT 
 +3       ;
 +4       ;
COMPARE(L,R) ;
 +1       ;
 +2        if $$RES("R")
               QUIT 1
 +3       ;
 +4        if '$LENGTH($ORDER(L("")))
               QUIT $$ADDREC^ORY2212("R")
 +5       ;
 +6        NEW C,OCXDD
           MERGE C=L,C=R
           SET OCXDD=$ORDER(C(""))
           QUIT $$MULT("C",OCXDD)
 +7       ;
 +8        QUIT 0
 +9       ;
RES(REF)  ;
 +1       ;
 +2        NEW QUIT,SUB
 +3        SET QUIT=0
 +4        SET SUB=""
           FOR 
               SET SUB=$ORDER(@REF@(SUB))
               if '$LENGTH(SUB)
                   QUIT 
               IF (SUB[":")
                   Begin DoDot:1
 +5                    NEW DD,DA
 +6                    SET DD=$PIECE(SUB,":",1)
                       SET DA=$PIECE(SUB,":",2)
 +7                    IF $LENGTH(DA)
                           IF '(DA=+DA)
                               Begin DoDot:2
 +8                                NEW DANEW,SUBNEW
 +9                                SET DANEW=$ORDER(^OCXS($PIECE(DA,U,2),"B",$PIECE(DA,U,1),0))
 +10                               IF 'DANEW
                                       WRITE !!,$PIECE($GET(^OCXS(+$PIECE(DA,U,2),0)),U,1),": ",$PIECE(DA,U,1),"  could not resolve name.",!!,"    End Transport."
                                       SET QUIT=1
                                       QUIT 
 +11                               SET SUBNEW=DD_":"_DANEW
 +12                               IF $DATA(@REF@(SUBNEW))
                                       WRITE !!," multiple #",DANEW," already existed."
                                       SET QUIT=1
                                       QUIT 
 +13                               MERGE @REF@(SUBNEW)=@REF@(SUB)
 +14                               KILL @REF@(SUB)
 +15                               SET SUB=""
                               End DoDot:2
                               if QUIT
                                   QUIT 
 +16                   IF $LENGTH(SUB)
                           IF ($DATA(@REF@(SUB))>9)
                               SET QUIT=$$RES($NAME(@REF@(SUB)))
                   End DoDot:1
                   if QUIT
                       QUIT 
 +17      ;
 +18       QUIT QUIT
 +19      ;
MULT(CREF,OCXDD) ;
 +1       ;
 +2        NEW OCXSUB,LREF,RREF,QUIT,OCXFLD
 +3        SET LREF="L"_$EXTRACT(CREF,2,$LENGTH(CREF))
           SET RREF="R"_$EXTRACT(CREF,2,$LENGTH(CREF))
 +4       ;
 +5        SET QUIT=0
           SET OCXFLD=""
           FOR 
               SET OCXFLD=$ORDER(@CREF@(OCXDD,OCXFLD))
               if '$LENGTH(OCXFLD)
                   QUIT 
               Begin DoDot:1
 +6                IF (OCXFLD[":")
                       Begin DoDot:2
 +7                        if $$EXFLD(+OCXFLD,0)
                               QUIT 
 +8                        IF '$DATA(@LREF@(OCXDD,OCXFLD,.01,"E"))
                               Begin DoDot:3
 +9                                DO WARN("Missing multiple:",CREF,OCXDD,OCXFLD)
 +10                               SET QUIT=$$ADDMULT^ORY2213(CREF,OCXDD,OCXFLD)
                               End DoDot:3
                               MERGE @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)
 +11                       IF '$DATA(@RREF@(OCXDD,OCXFLD,.01,"E"))
                               Begin DoDot:3
 +12                               DO WARN("Extra multiple:",CREF,OCXDD,OCXFLD)
 +13                               SET QUIT=$$DELMULT^ORY2213($$APPEND(CREF,OCXDD),OCXFLD)
                               End DoDot:3
                               MERGE @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)
                       End DoDot:2
                       if QUIT
                           QUIT 
 +14      ;
 +15               IF (OCXFLD=+OCXFLD)
                       IF '$$EXFLD(+OCXDD,OCXFLD)
                           Begin DoDot:2
 +16                           IF ($ORDER(@CREF@(OCXDD,OCXFLD,""))="E")
                                   Begin DoDot:3
 +17                                   IF $LENGTH($GET(@RREF@(OCXDD,OCXFLD,"E")))
                                           IF '$LENGTH($GET(@LREF@(OCXDD,OCXFLD,"E")))
                                               Begin DoDot:4
 +18                                               DO WARN("Data Value Missing in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
 +19                                               SET QUIT=$$EDITFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
                                               End DoDot:4
                                               QUIT 
 +20                                   IF $LENGTH($GET(@LREF@(OCXDD,OCXFLD,"E")))
                                           IF '$LENGTH($GET(@RREF@(OCXDD,OCXFLD,"E")))
                                               Begin DoDot:4
 +21                                               DO WARN("Extra Data Value in "_$$NETNAME^OCXSEND,CREF,OCXDD,OCXFLD,"E")
 +22                                               SET QUIT=$$DELFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
                                               End DoDot:4
                                               QUIT 
 +23                                   IF '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E"))
                                           Begin DoDot:4
 +24                                           DO WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")
 +25                                           SET QUIT=$$EDITFLD^ORY2214(CREF,OCXDD,OCXFLD,"E")
                                           End DoDot:4
                                   End DoDot:3
                                   QUIT 
 +26                           SET OCXSUB=0
                               FOR 
                                   if QUIT
                                       QUIT 
                                   SET OCXSUB=$ORDER(@CREF@(OCXDD,OCXFLD,OCXSUB))
                                   if 'OCXSUB
                                       QUIT 
                                   IF '($GET(@RREF@(OCXDD,OCXFLD,OCXSUB))=$GET(@LREF@(OCXDD,OCXFLD,OCXSUB)))
                                       Begin DoDot:3
 +27                                       DO WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)
 +28                                       SET QUIT=$$LOADWORD^ORY2212(RREF,OCXDD,OCXFLD,OCXSUB)
                                       End DoDot:3
                                       QUIT 
                           End DoDot:2
 +29      ;
 +30               IF 'QUIT
                       IF (OCXFLD[":")
                           SET QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)
               End DoDot:1
               if QUIT
                   QUIT 
 +31       QUIT QUIT
 +32      ;
APPEND(ARRAY,OCXSUB) ;
 +1        if '(OCXSUB=+OCXSUB)
               SET OCXSUB=""""_OCXSUB_""""
 +2        if '(ARRAY["(")
               QUIT ARRAY_"("_OCXSUB_")"
 +3        QUIT $EXTRACT(ARRAY,1,$LENGTH(ARRAY)-1)_","_OCXSUB_")"
 +4       ;
EXFLD(FILE,OCXFLD) ;
 +1        NEW OCXFNAM
 +2        SET OCXFNAM=$$FIELD^OCXSENDD(FILE,OCXFLD,"LABEL")
 +3        IF (OCXFNAM["UNIQUE OBJECT IDENTIFIER")
               QUIT 1
 +4        IF (FILE=860.2)
               IF (OCXFLD=.02)
                   QUIT 1
 +5        IF (FILE=860.22)
               IF (OCXFLD=4)
                   QUIT 1
 +6        IF (FILE=860.3)
               IF (OCXFLD=3)
                   QUIT 1
 +7        IF (FILE=860.9)
               IF (OCXFLD=1)
                   QUIT 1
 +8        IF (FILE=860.91)
               QUIT 1
 +9        IF (FILE=860.801)
               QUIT 1
 +10       IF (FILE=860.81)
               QUIT 1
 +11       IF (FILE=861.01)
               QUIT 1
 +12       IF (FILE=863.02)
               QUIT 1
 +13       IF (FILE=863.54)
               QUIT 1
 +14       IF (FILE=863.61)
               QUIT 1
 +15       IF (FILE=863.72)
               QUIT 1
 +16       IF (FILE=863.81)
               QUIT 1
 +17       IF ($EXTRACT(OCXFNAM,1)="*")
               QUIT 1
 +18       QUIT 0
 +19      ;
WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;
 +1       ;
 +2        if $GET(OCXAUTO)
               QUIT 
 +3       ;
 +4        NEW D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF
 +5       ;
 +6        SET DASH=""
           SET $PIECE(DASH,"-",(55-$LENGTH(MSG)))="-"
 +7        WRITE !!,"------------",MSG,DASH
 +8        DO DSPHDR(CREF,OCXDD,OCXFLD)
 +9        IF $DATA(OCXSUB)
               DO DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)
 +10       IF '$DATA(OCXSUB)
               DO DSPREC(CREF,OCXDD,OCXFLD)
 +11      ;
 +12       WRITE !
           QUIT 
 +13      ;
DSPREC(CREF,OCXDD,OCXFLD) ;
 +1       ;
 +2        NEW OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB
 +3        SET OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)
 +4        SET OCXDDPTH=$PIECE($PIECE(OCXCREF,"(",2),")",1)
           SET LEVL=$LENGTH(OCXDDPTH,",")
 +5        SET OCXSUB=""
           FOR 
               SET OCXSUB=$ORDER(@OCXCREF@(OCXSUB))
               if '$LENGTH(OCXSUB)
                   QUIT 
               Begin DoDot:1
 +6       ;
 +7                IF '(OCXSUB[":")
                       IF '((OCXSUB=.01)&$ORDER(@OCXCREF@(OCXSUB)))
                           Begin DoDot:2
 +8                            NEW LINE
 +9                            if $$EXFLD(+OCXFLD,OCXSUB)
                                   QUIT 
 +10                           IF OCXFLD
                                   WRITE !,?(5+((LEVL)*4)),$$FIELD^OCXSENDD(+OCXFLD,OCXSUB,"LABEL"),": ",$GET(@OCXCREF@(OCXSUB,"E"))
 +11                           SET LINE=0
                               FOR 
                                   SET LINE=$ORDER(@OCXCREF@(OCXSUB,LINE))
                                   if 'LINE
                                       QUIT 
                                   Begin DoDot:3
 +12                                   WRITE !,?(5+(LEVL*4)),$JUSTIFY(LINE,3),">",@OCXCREF@(OCXSUB,LINE)
                                   End DoDot:3
                           End DoDot:2
 +13      ;
 +14               IF (OCXSUB[":")
                       Begin DoDot:2
 +15                       NEW D0,OCXDD,FILENAME
 +16                       SET D0=+$PIECE(OCXSUB,":",2)
                           SET OCXDD=+OCXSUB
 +17                       SET FILENAME=$$FILENAME^OCXSENDD(OCXDD)
 +18                       IF $LENGTH(FILENAME)
                               WRITE !,?(5+($LENGTH(LEVL)*4)),FILENAME
 +19                      IF '$TEST
                               WRITE !!,?(5+(LEVL*4)),FILENAME
 +20                       WRITE " ",D0,": ",$GET(@OCXCREF@(OCXSUB,.01,"E"))
 +21                       DO DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)
                       End DoDot:2
               End DoDot:1
 +22      ;
 +23       QUIT 
 +24      ;
DSPHDR(CREF,OCXDD,OCXFLD) ;
 +1       ;
 +2        NEW D0,FILE,FILEID,OCXPTR,OCXDDPTH
 +3        SET OCXDDPTH=$PIECE($PIECE($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)
 +4        SET FILE=""
           FOR OCXPTR=1:1:$LENGTH(OCXDDPTH,",")
               Begin DoDot:1
 +5                NEW OCXDD,D0,FILEID
 +6                SET FILEID=$PIECE(OCXDDPTH,",",OCXPTR)
 +7                IF (FILEID[":")
                       Begin DoDot:2
 +8                        SET D0=+$PIECE(FILEID,":",2)
                           SET OCXDD=+$EXTRACT(FILEID,2,$LENGTH(FILEID))
 +9                        WRITE !,?(5+(OCXPTR*4)),$$FILENAME^OCXSENDD(OCXDD)
 +10                       if $LENGTH(FILE)
                               SET FILE=FILE_","
                           SET FILE=FILE_FILEID
 +11                       IF $DATA(@("L("_FILE_",.01,""E"")"))
                               WRITE ": ",@("L("_FILE_",.01,""E"")")
                               if D0
                                   WRITE " [",D0,"]"
 +12                      IF '$TEST
                               IF $DATA(@("R("_FILE_",.01,""E"")"))
                                   WRITE ": ",@("R("_FILE_",.01,""E"")")
                                   if D0
                                       WRITE " [",D0,"]"
                       End DoDot:2
               End DoDot:1
 +13      ;
 +14       QUIT 
 +15      ;
DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;
 +1       ;
 +2        NEW OCXDPTR,LREF,RREF,OCXDDPTH
 +3       ;
 +4        SET OCXDDPTH=$PIECE($PIECE($$APPEND(CREF,OCXDD),"(",2),")",1)
 +5        SET LREF="L("_OCXDDPTH_")"
           SET RREF="R("_OCXDDPTH_")"
 +6        WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+1)*4)),$$FIELD^OCXSENDD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"
 +7        IF OCXSUB
               WRITE " Line #",OCXSUB
 +8       ;
 +9        if ($DATA(@RREF@(OCXFLD,OCXSUB)))
               WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(R) DEVCUR.FO-SLC.DOMAIN.EXT: ",@RREF@(OCXFLD,OCXSUB)
 +10       if ($DATA(@LREF@(OCXFLD,OCXSUB)))
               WRITE !,?(5+(($LENGTH(OCXDDPTH,",")+2)*4)),"(L) ",$$NETNAME^OCXSEND,": ",@LREF@(OCXFLD,OCXSUB)
 +11      ;
 +12       QUIT 
 +13      ;
 +14       WRITE !,?10
           QUIT 0
           QUIT $$PAUSE
 +15      ;
PAUSE()    WRITE "  Press Enter "
           READ X:DTIME
           WRITE !
           QUIT (X[U)
 +1       ;
NOW()      NEW X,Y,%DT
           SET X="N"
           SET %DT="T"
           DO ^%DT
           SET Y=$$DATE^OCXSENDD(Y)
           if (Y["@")
               SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
           QUIT Y
 +1       ;