- 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 Jan 18, 2025@03:40:37 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 ;