OCXBDT5.m

OCXBDT5 ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Build Runtime Library Routine OCXDI1) ;8/04/98  13:21

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

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

 ;

EN() ;

 ;

 N R,LINE,TEXT,NOW,RUCI,XCM

 S NOW=$$NOW^OCXBDT3,RUCI=$$CUCI^OCXBDT

 F LINE=1:1:999 S TEXT=$P($T(TEXT+LINE),";",2,999) Q:TEXT  S TEXT=$P(TEXT,";",2,999) S R(LINE,0)=$$CONV^OCXBDT3(TEXT)

 ;

 M ^TMP("OCXBDT",$J,"RTN")=R

 ;

 S DIE="^TMP(""OCXBDT"","_$J_",""RTN"",",XCN=0,X="OCXDI1"

 W !,X X ^%ZOSF("SAVE") W "  ... ",XCM," Lines filed" K ^TMP("OCXBDT",$J,"RTN")

 ;

 Q XCM

 ;

TEXT ;

 ;;OCXDI1 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;|NOW|

 ;;|OCXLIN2|

 ;;|OCXLIN3|

 ;; ;

 ;;S ;

 ;; ;

 ;; Q

 ;; ;

 ;; ;

 ;;COMPARE(L,R) ;

 ;; ;

 ;; Q:'$L($O(L(""))) $$ADDREC^OCXDI2("R")

 ;; ;

 ;; N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)

 ;; ;

 ;; Q 0

 ;; ;

 ;;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^OCXDI3(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^OCXDI3($$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 "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")

 ;; ....S QUIT=$$EDITFLD^OCXDI4(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 "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")

 ;; ....S QUIT=$$DELFLD^OCXDI4(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^OCXDI4(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^OCXDI2(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^OCXBDTD(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=19),(OCXFLD=.15) Q 1

 ;; I (FILE=19),(OCXFLD=.16) Q 1

 ;; I (FILE=19),(OCXFLD=.26) Q 1

 ;; I (FILE=19),(OCXFLD=1.1) Q 1

 ;; I (FILE=19),(OCXFLD=3.6) Q 1

 ;; I (FILE=19),(OCXFLD=14) Q 1

 ;; I (FILE=19),(OCXFLD=99) Q 1

 ;; I (FILE=19),(OCXFLD=99.1) Q 1

 ;; I (FILE=19),(OCXFLD=200) Q 1

 ;; I (FILE=19),(OCXFLD=201) Q 1

 ;; I (FILE=19),(OCXFLD=203) 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

 ;; ;

 ;; Q:'OCXFLGR

 ;; ;

 ;; S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"

 ;; W !!,"----WARNING-",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^OCXBDTD(+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^OCXBDTD(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^OCXBDTD(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^OCXBDTD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"

 ;; I OCXSUB W " Line #",OCXSUB

 ;; ;

 ;; W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) |RUCI|: ",@RREF@(OCXFLD,OCXSUB)

 ;; W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$CUCI^OCXBDT,": ",@LREF@(OCXFLD,OCXSUB)

 ;; ;

 ;; Q

 ;; ;

 ;; W !,?10 Q 0 Q $$PAUSE

 ;; ;

 ;;PAUSE() Q:'OCXFLGC 0 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^OCXBDTD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y

 ;; ;

 ;;$

 ;1;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OCXBDT5   6470     printed  Oct 16, 2024@18:23:01                                                                                                                                                                                                     Page 2

OCXBDT5   ;SLC/RJS,CLA - BUILD OCX PACKAGE DIAGNOSTIC ROUTINES (Build Runtime Library Routine OCXDI1) ;8/04/98  13:21

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

 +2        NEW R,LINE,TEXT,NOW,RUCI,XCM

 +3        SET NOW=$$NOW^OCXBDT3

           SET RUCI=$$CUCI^OCXBDT

 +4        FOR LINE=1:1:999

               SET TEXT=$PIECE($TEXT(TEXT+LINE),";",2,999)

               if TEXT

                   QUIT 

               SET TEXT=$PIECE(TEXT,";",2,999)

               SET R(LINE,0)=$$CONV^OCXBDT3(TEXT)

 +5       ;

 +6        MERGE ^TMP("OCXBDT",$JOB,"RTN")=R

 +7       ;

 +8        SET DIE="^TMP(""OCXBDT"","_$JOB_",""RTN"","

           SET XCN=0

           SET X="OCXDI1"

 +9        WRITE !,X

           XECUTE ^%ZOSF("SAVE")

           WRITE "  ... ",XCM," Lines filed"

           KILL ^TMP("OCXBDT",$JOB,"RTN")

 +10      ;

 +11       QUIT XCM

 +12      ;

TEXT      ;

 +1       ;;OCXDI1 ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC UTILITY ROUTINE ;|NOW|

 +2       ;;|OCXLIN2|

 +3       ;;|OCXLIN3|

 +4       ;; ;

 +5       ;;S ;

 +6       ;; ;

 +7       ;; Q

 +8       ;; ;

 +9       ;; ;

 +10      ;;COMPARE(L,R) ;

 +11      ;; ;

 +12      ;; Q:'$L($O(L(""))) $$ADDREC^OCXDI2("R")

 +13      ;; ;

 +14      ;; N C,OCXDD M C=L,C=R S OCXDD=$O(C("")) Q $$MULT("C",OCXDD)

 +15      ;; ;

 +16      ;; Q 0

 +17      ;; ;

 +18      ;;MULT(CREF,OCXDD) ;

 +19      ;; ;

 +20      ;; N OCXSUB,LREF,RREF,QUIT,OCXFLD

 +21      ;; S LREF="L"_$E(CREF,2,$L(CREF)),RREF="R"_$E(CREF,2,$L(CREF))

 +22      ;; S QUIT=0,OCXFLD="" F  S OCXFLD=$O(@CREF@(OCXDD,OCXFLD)) Q:'$L(OCXFLD)  D  Q:QUIT

 +23      ;; .I (OCXFLD[":") D  Q:QUIT

 +24      ;; ..Q:$$EXFLD(+OCXFLD,0)

 +25      ;; ..I '$D(@LREF@(OCXDD,OCXFLD,.01,"E")) D  M @LREF@(OCXDD,OCXFLD)=@RREF@(OCXDD,OCXFLD)

 +26      ;; ...D WARN("Missing multiple:",CREF,OCXDD,OCXFLD)

 +27      ;; ...S QUIT=$$ADDMULT^OCXDI3(CREF,OCXDD,OCXFLD)

 +28      ;; ..I '$D(@RREF@(OCXDD,OCXFLD,.01,"E")) D  M @RREF@(OCXDD,OCXFLD)=@LREF@(OCXDD,OCXFLD)

 +29      ;; ...D WARN("Extra multiple:",CREF,OCXDD,OCXFLD)

 +30      ;; ...S QUIT=$$DELMULT^OCXDI3($$APPEND(CREF,OCXDD),OCXFLD)

 +31      ;; .;

 +32      ;; .I (OCXFLD=+OCXFLD),'$$EXFLD(+OCXDD,OCXFLD) D

 +33      ;; ..I ($O(@CREF@(OCXDD,OCXFLD,""))="E") D  Q

 +34      ;; ...I $L($G(@RREF@(OCXDD,OCXFLD,"E"))),'$L($G(@LREF@(OCXDD,OCXFLD,"E"))) D  Q

 +35      ;; ....D WARN("Data Value Missing in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")

 +36      ;; ....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")

 +37      ;; ...I $L($G(@LREF@(OCXDD,OCXFLD,"E"))),'$L($G(@RREF@(OCXDD,OCXFLD,"E"))) D  Q

 +38      ;; ....D WARN("Extra Data Value in "_$$CUCI^OCXBDT,CREF,OCXDD,OCXFLD,"E")

 +39      ;; ....S QUIT=$$DELFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")

 +40      ;; ...I '(@LREF@(OCXDD,OCXFLD,"E")=@RREF@(OCXDD,OCXFLD,"E")) D

 +41      ;; ....D WARN("Inconsistent Data",CREF,OCXDD,OCXFLD,"E")

 +42      ;; ....S QUIT=$$EDITFLD^OCXDI4(CREF,OCXDD,OCXFLD,"E")

 +43      ;; ..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

 +44      ;; ...D WARN("Inconsistent word Data",CREF,OCXDD,OCXFLD,OCXSUB)

 +45      ;; ...S QUIT=$$LOADWORD^OCXDI2(RREF,OCXDD,OCXFLD,OCXSUB)

 +46      ;; .;

 +47      ;; .I 'QUIT,(OCXFLD[":") S QUIT=$$MULT($$APPEND(CREF,OCXDD),OCXFLD)

 +48      ;; Q QUIT

 +49      ;; ;

 +50      ;;APPEND(ARRAY,OCXSUB) ;

 +51      ;; S:'(OCXSUB=+OCXSUB) OCXSUB=""""_OCXSUB_""""

 +52      ;; Q:'(ARRAY["(") ARRAY_"("_OCXSUB_")"

 +53      ;; Q $E(ARRAY,1,$L(ARRAY)-1)_","_OCXSUB_")"

 +54      ;; ;

 +55      ;;EXFLD(FILE,OCXFLD) ;

 +56      ;; N OCXFNAM

 +57      ;; S OCXFNAM=$$FIELD^OCXBDTD(FILE,OCXFLD,"LABEL")

 +58      ;; I (OCXFNAM["UNIQUE OBJECT IDENTIFIER") Q 1

 +59      ;; I (FILE=860.2),(OCXFLD=.02) Q 1

 +60      ;; I (FILE=860.22),(OCXFLD=4) Q 1

 +61      ;; I (FILE=860.3),(OCXFLD=3) Q 1

 +62      ;; I (FILE=860.9),(OCXFLD=1) Q 1

 +63      ;; I (FILE=860.91) Q 1

 +64      ;; I (FILE=19),(OCXFLD=.15) Q 1

 +65      ;; I (FILE=19),(OCXFLD=.16) Q 1

 +66      ;; I (FILE=19),(OCXFLD=.26) Q 1

 +67      ;; I (FILE=19),(OCXFLD=1.1) Q 1

 +68      ;; I (FILE=19),(OCXFLD=3.6) Q 1

 +69      ;; I (FILE=19),(OCXFLD=14) Q 1

 +70      ;; I (FILE=19),(OCXFLD=99) Q 1

 +71      ;; I (FILE=19),(OCXFLD=99.1) Q 1

 +72      ;; I (FILE=19),(OCXFLD=200) Q 1

 +73      ;; I (FILE=19),(OCXFLD=201) Q 1

 +74      ;; I (FILE=19),(OCXFLD=203) Q 1

 +75      ;; I ($E(OCXFNAM,1)="*") Q 1

 +76      ;; Q 0

 +77      ;; ;

 +78      ;;WARN(MSG,CREF,OCXDD,OCXFLD,OCXSUB) ;

 +79      ;; ;

 +80      ;; Q:$G(OCXAUTO)

 +81      ;; ;

 +82      ;; N D0,DASH,OCXDDPTH,OCXDPTR,FILE,FILEID,LREF,OCXPTR,RREF

 +83      ;; ;

 +84      ;; Q:'OCXFLGR

 +85      ;; ;

 +86      ;; S DASH="",$P(DASH,"-",(55-$L(MSG)))="-"

 +87      ;; W !!,"----WARNING-",MSG,DASH

 +88      ;; D DSPHDR(CREF,OCXDD,OCXFLD)

 +89      ;; I $D(OCXSUB) D DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB)

 +90      ;; I '$D(OCXSUB) D DSPREC(CREF,OCXDD,OCXFLD)

 +91      ;; ;

 +92      ;; W ! Q

 +93      ;; ;

 +94      ;;DSPREC(CREF,OCXDD,OCXFLD) ;

 +95      ;; ;

 +96      ;; N OCXDPTR,OCXDDPTH,LEVL,OCXCREF,OCXSUB

 +97      ;; S OCXCREF=$$APPEND($$APPEND(CREF,OCXDD),OCXFLD)

 +98      ;; S OCXDDPTH=$P($P(OCXCREF,"(",2),")",1),LEVL=$L(OCXDDPTH,",")

 +99      ;; S OCXSUB="" F  S OCXSUB=$O(@OCXCREF@(OCXSUB)) Q:'$L(OCXSUB)  D

 +100     ;; .;

 +101     ;; .I '(OCXSUB[":"),'((OCXSUB=.01)&$O(@OCXCREF@(OCXSUB))) D

 +102     ;; ..N LINE

 +103     ;; ..Q:$$EXFLD(+OCXFLD,OCXSUB)

 +104     ;; ..I OCXFLD W !,?(5+((LEVL)*4)),$$FIELD^OCXBDTD(+OCXFLD,OCXSUB,"LABEL"),": ",$G(@OCXCREF@(OCXSUB,"E"))

 +105     ;; ..S LINE=0 F  S LINE=$O(@OCXCREF@(OCXSUB,LINE)) Q:'LINE  D

 +106     ;; ...W !,?(5+(LEVL*4)),$J(LINE,3),">",@OCXCREF@(OCXSUB,LINE)

 +107     ;; .;

 +108     ;; .I (OCXSUB[":") D

 +109     ;; ..N D0,OCXDD,FILENAME

 +110     ;; ..S D0=+$P(OCXSUB,":",2),OCXDD=+OCXSUB

 +111     ;; ..S FILENAME=$$FILENAME^OCXBDTD(OCXDD)

 +112     ;; ..I $L(FILENAME) W !,?(5+($L(LEVL)*4)),FILENAME

 +113     ;; ..E  W !!,?(5+(LEVL*4)),FILENAME

 +114     ;; ..W " ",D0,": ",$G(@OCXCREF@(OCXSUB,.01,"E"))

 +115     ;; ..D DSPREC($$APPEND(CREF,OCXDD),OCXFLD,OCXSUB)

 +116     ;; ;

 +117     ;; Q

 +118     ;; ;

 +119     ;;DSPHDR(CREF,OCXDD,OCXFLD) ;

 +120     ;; ;

 +121     ;; N D0,FILE,FILEID,OCXPTR,OCXDDPTH

 +122     ;; S OCXDDPTH=$P($P($$APPEND($$APPEND(CREF,OCXDD),OCXFLD),"(",2),")",1)

 +123     ;; S FILE="" F OCXPTR=1:1:$L(OCXDDPTH,",") D

 +124     ;; .N OCXDD,D0,FILEID

 +125     ;; .S FILEID=$P(OCXDDPTH,",",OCXPTR)

 +126     ;; .I (FILEID[":") D

 +127     ;; ..S D0=+$P(FILEID,":",2),OCXDD=+$E(FILEID,2,$L(FILEID))

 +128     ;; ..W !,?(5+(OCXPTR*4)),$$FILENAME^OCXBDTD(OCXDD)

 +129     ;; ..S:$L(FILE) FILE=FILE_"," S FILE=FILE_FILEID

 +130     ;; ..I $D(@("L("_FILE_",.01,""E"")")) W ": ",@("L("_FILE_",.01,""E"")") W:D0 " [",D0,"]"

 +131     ;; ..E  I $D(@("R("_FILE_",.01,""E"")")) W ": ",@("R("_FILE_",.01,""E"")") W:D0 " [",D0,"]"

 +132     ;; ;

 +133     ;; Q

 +134     ;; ;

 +135     ;;DSPFLD(CREF,OCXDD,OCXFLD,OCXSUB) ;

 +136     ;; ;

 +137     ;; N OCXDPTR,LREF,RREF,OCXDDPTH

 +138     ;; ;

 +139     ;; S OCXDDPTH=$P($P($$APPEND(CREF,OCXDD),"(",2),")",1)

 +140     ;; S LREF="L("_OCXDDPTH_")",RREF="R("_OCXDDPTH_")"

 +141     ;; W !,?(5+(($L(OCXDDPTH,",")+1)*4)),$$FIELD^OCXBDTD(OCXDD,OCXFLD,"LABEL")," field [",OCXFLD,"]"

 +142     ;; I OCXSUB W " Line #",OCXSUB

 +143     ;; ;

 +144     ;; W:($D(@RREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(R) |RUCI|: ",@RREF@(OCXFLD,OCXSUB)

 +145     ;; W:($D(@LREF@(OCXFLD,OCXSUB))) !,?(5+(($L(OCXDDPTH,",")+2)*4)),"(L) ",$$CUCI^OCXBDT,": ",@LREF@(OCXFLD,OCXSUB)

 +146     ;; ;

 +147     ;; Q

 +148     ;; ;

 +149     ;; W !,?10 Q 0 Q $$PAUSE

 +150     ;; ;

 +151     ;;PAUSE() Q:'OCXFLGC 0 W "  Press Enter " R X:DTIME W ! Q (X[U)

 +152     ;; ;

 +153     ;;NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT S Y=$$DATE^OCXBDTD(Y) S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y

 +154     ;; ;

 +155     ;;$

 +156     ;1;

 +157     ;