ORY4271 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE ; 11/28/18 3:39pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 105
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
;Reference to ^%DT supported by DBIA #10003
; This is a post intall routine and can be deleted after install of patch OR*3*427
S ;
;
Q
;
;
COMPARE(L,R) ;
;
Q:$$RES("R") 1
;
Q:'$L($O(L(""))) $$ADDREC^ORY4272("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^ORY4273(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^ORY4273($$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^ORY4274(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^ORY4274(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^ORY4274(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^ORY4272(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) NCCLAB1.AAC.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[HORY4271 6106 printed Dec 13, 2024@02:42:15 Page 2
ORY4271 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE ; 11/28/18 3:39pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**427**;Dec 17,1997;Build 105
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ;Reference to ^%DT supported by DBIA #10003
+5 ; This is a post intall routine and can be deleted after install of patch OR*3*427
S ;
+1 ;
+2 QUIT
+3 ;
+4 ;
COMPARE(L,R) ;
+1 ;
+2 if $$RES("R")
QUIT 1
+3 ;
+4 if '$LENGTH($ORDER(L("")))
QUIT $$ADDREC^ORY4272("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^ORY4273(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^ORY4273($$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^ORY4274(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^ORY4274(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^ORY4274(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^ORY4272(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) NCCLAB1.AAC.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 ;
