OCXOCMP1 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Data Field Navigation Code) ;12/22/98 13:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN() ;
;
Q:$G(OCXWARN) OCXWARN
S OCXDF=0 F S OCXDF=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) Q:'OCXDF D Q:OCXWARN
.N OCXGETC,OCXGETN,OCXCOD2,OCXERR,OCXNAM,OCXPARM
.N OCXPATH,OCXCON,OCXFCODE,OCXDPTR,OCXREC,OCXATT
.K OCXREC(4) M OCXREC(4)=^OCXS(860.4,OCXDF)
.S OCXNAM=$P($G(OCXREC(4,0)),U,1) Q:'$L(OCXNAM)
.S OCXCON=0 F S OCXCON=$O(OCXREC(4,"LINK",OCXCON)) Q:'OCXCON D Q:$G(OCXWARN)
..K OCXREC(6) M OCXREC(6)=^OCXS(860.6,OCXCON)
..S OCXCONN=$P($G(OCXREC(6,0)),U,1) I '$L(OCXCONN) D WARN^OCXOCMPV("Data context IEN #"_(+OCXCON)_" not defined in Data Context file...",4,OCXDF,$P($T(+1)," ",1)) Q
..S OCXCONA=$P($G(OCXREC(6,0)),U,2) I '$L(OCXCONA) D WARN^OCXOCMPV("Data context abbreviation for '"_OCXCONN_"' not defined in Data Context file...",4,OCXDF,$P($T(+1)," ",1)) Q
..S OCXPATH=$G(OCXREC(4,"LINK",OCXCON,"DATAPATH")) I '$L(OCXPATH) D WARN^OCXOCMPV("Data Link-Path not defined",4,OCXDF,$P($T(+1)," ",1)) Q
..S OCXLNK=$O(^OCXS(863.3,"B",OCXPATH,0)) I 'OCXLNK D WARN^OCXOCMPV("Data Link-Path '"_OCXPATH_"' not defined in Meta-Dictionary Link file...",4,OCXDF,$P($T(+1)," ",1)) Q
..S OCXATT=$P($G(^OCXS(863.3,OCXLNK,0)),U,5) I 'OCXATT D WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' ("_OCXLNK_") not defined in Meta-Dictionary Attribute file...",4,OCXDF,$P($T(+1)," ",1)) Q
..I '$G(OCXAUTO) W:($X>60) ! W "."
..S $P(OCXREC(4,0),U,3)=""
..F OCXPARM="OCXO EXTERNAL FUNCTION CALL","OCXO VARIABLE NAME","OCXO VT-BAR PIECE NUMBER","OCXO UP-ARROW PIECE NUMBER","OCXO SEMI-COLON PIECE NUMBER","OCXO HL7 SEGMENT ID","OCXO FILE POINTER" D
...Q:'$O(^OCXS(863.8,"B",OCXPARM,0))
...S OCXPARM(OCXPARM)=$$GETPARM(33,OCXPATH,OCXPARM) I '$L(OCXPARM(OCXPARM)) K OCXPARM(OCXPARM) Q
..S OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
..I '$L(OCXDTYP) D WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type not defined in Meta-Dictionary Attribute file...",4,OCXDF,$P($T(+1)," ",1)) Q
..S:'OCXDTYP OCXDTYP=$O(^OCXS(864.1,"B",OCXDTYP,0)) S OCXDTYPN=$P($G(^OCXS(864.1,+OCXDTYP,0)),U,1)
..I '$L(OCXDTYPN) D WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type '"_OCXDTYP_"' not defined in Meta-Dictionary Data Type file...",4,OCXDF,$P($T(+1)," ",1)) Q
..;
..S OCXFCODE(OCXCON,"AN")=OCXNAM
..S OCXFCODE(OCXCON,"AV")="OCXDF("_(+OCXDF)_")"
..S OCXFCODE(OCXCON,"CN")=OCXCONN
..S OCXFCODE(OCXCON,"CA")=OCXCONA
..S OCXFCODE(OCXCON,"DTYP","DATA TYPE INDEX")=OCXDTYP
..S OCXFCODE(OCXCON,"DTYP","DATA TYPE NAME")=OCXDTYPN
..S OCXFCODE(OCXCON,"DA MODE")=+$P($G(OCXREC(6,0)),U,3)
..;
..S $P(^OCXS(860.4,OCXDF,0),U,3)=OCXDTYP
..Q:$G(OCXERR)
..;
..I $L($G(OCXPARM("OCXO EXTERNAL FUNCTION CALL"))) D
...I '$L($G(OCXPARM("OCXO VARIABLE NAME"))) D
....I ($E(OCXPARM("OCXO EXTERNAL FUNCTION CALL"),1)="(") S OCXGETC=OCXPARM("OCXO EXTERNAL FUNCTION CALL")
....E S OCXGETC="$$"_OCXPARM("OCXO EXTERNAL FUNCTION CALL")
...I $L($G(OCXPARM("OCXO VARIABLE NAME"))) D
....I (OCXTLOG),((OCXPARM("OCXO EXTERNAL FUNCTION CALL")?.8AN1"^"1.8AN1"(".E)!(OCXPARM("OCXO EXTERNAL FUNCTION CALL")?1.8AN1"(".E)) D I 1
.....N OCXX
.....S OCXX="S OCXOERR=$$TIMELOG(""O"","""_$P(OCXPARM("OCXO EXTERNAL FUNCTION CALL")_"(","(",1)_""")"
.....S OCXX=OCXX_" D "_OCXPARM("OCXO EXTERNAL FUNCTION CALL")
.....S OCXX=OCXX_" S OCXOERR=$$TIMELOG(""I"","""_$P(OCXPARM("OCXO EXTERNAL FUNCTION CALL")_"(","(",1)_""")"
.....D FILECODE(OCXCON,OCXX,"SDS")
....E D FILECODE(OCXCON,"D "_OCXPARM("OCXO EXTERNAL FUNCTION CALL"),"D")
....S OCXGETC=$G(OCXPARM("OCXO VARIABLE NAME"))
..;
..I '$L($G(OCXPARM("OCXO EXTERNAL FUNCTION CALL"))) D
...I '$L($G(OCXPARM("OCXO VARIABLE NAME"))) D
....D WARN^OCXOCMPV("Not enough information in the MetaDictionary link file to generate navigation code.",4,OCXDF,$P($T(+1)," ",1)) S OCXERR=1 Q
...I $L($G(OCXPARM("OCXO VARIABLE NAME"))) S OCXGETC="$G("_$G(OCXPARM("OCXO VARIABLE NAME"))_")"
..;
..Q:OCXWARN
..;
..S:$L($G(OCXPARM("OCXO VT-BAR PIECE NUMBER"))) OCXGETC="$P("_OCXGETC_",""|"","_(OCXPARM("OCXO VT-BAR PIECE NUMBER")+1)_")"
..S:$G(OCXPARM("OCXO UP-ARROW PIECE NUMBER")) OCXGETC="$P("_OCXGETC_",""^"","_OCXPARM("OCXO UP-ARROW PIECE NUMBER")_")"
..S:$G(OCXPARM("OCXO SEMI-COLON PIECE NUMBER")) OCXGETC="$P("_OCXGETC_","";"","_OCXPARM("OCXO SEMI-COLON PIECE NUMBER")_")"
..;
..I ($L($G(OCXPARM("OCXO FILE POINTER")))) D
...N OCXX S OCXX=OCXPARM("OCXO FILE POINTER")
...I (OCXX=(+OCXX)) S OCXGETC="$$POINTER("_(+OCXX)_","_OCXGETC_")"
...E S OCXGETC="$$POINTER("""_(OCXX)_""","_OCXGETC_")"
..S:(OCXDTYPN="DATE/TIME") OCXGETC="$$DT2INT("_OCXGETC_")"
..Q:'$L(OCXGETC)
..S OCXFCODE(OCXCON,"G")=OCXGETC
..D FILECODE(OCXCON,"S OCXDF("_(+OCXDF)_")="_OCXGETC)
..I $G(OCXTRACE) D
...N OCXTXT
...I $D(OCXPARM("OCXO VARIABLE NAME")) D
....S OCXTXT="W:$D("_OCXPARM("OCXO VARIABLE NAME")_") !,||LNTAG||,?30,""Data Field: "_$E(OCXNAM,1,25)_" : "",?30,"" ("
....I $D(OCXCONA) S OCXTXT=OCXTXT_" "_OCXCONA
....I $D(OCXPARM("OCXO VARIABLE NAME")) S OCXTXT=OCXTXT_" "_$$DBLQT(OCXPARM("OCXO VARIABLE NAME"))
....I $D(OCXPARM("OCXO HL7 SEGMENT ID")) S OCXTXT=OCXTXT_" "_OCXPARM("OCXO HL7 SEGMENT ID")
....I $D(OCXPARM("OCXO VT-BAR PIECE NUMBER")) S OCXTXT=OCXTXT_" "_OCXPARM("OCXO VT-BAR PIECE NUMBER")
....I $D(OCXPARM("OCXO UP-ARROW PIECE NUMBER")) S OCXTXT=OCXTXT_" piece "_OCXPARM("OCXO UP-ARROW PIECE NUMBER")
....I (OCXDTYPN="DATE/TIME") S OCXTXT=OCXTXT_" ) "",$$INT2DT("_OCXGETC_",1)"
....E I (OCXDTYPN="BOOLEAN") S OCXTXT=OCXTXT_" ) "",$S(+"_OCXGETC_":""TRUE"",1:""FALSE"")"
....E S OCXTXT=OCXTXT_" ) "","_OCXGETC
....I $L($G(OCXPARM("OCXO HL7 SEGMENT ID"))) D
.....S ^TMP("OCXCMP",$J,"DATA FIELD TRACE","HL7",$G(OCXPARM("OCXO HL7 SEGMENT ID")," "),+$G(OCXPARM("OCXO VT-BAR PIECE NUMBER")),+$G(OCXPARM("OCXO UP-ARROW PIECE NUMBER")),OCXDF)=OCXTXT
....E S ^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXCON,0,0,+$G(OCXPARM("OCXO UP-ARROW PIECE NUMBER")),OCXDF)=OCXTXT
...;
...D FILECODE(OCXCON,"W:$G(OCXTRACE) !,||LNTAG||,?30,""Data Field: "_OCXNAM_" = """""",OCXDF("_(+OCXDF)_"),""""""""")
..I 0 D FILECODE(OCXCON,"S OCXOERR=$$LOGDF("_(+OCXDF)_","_(+OCXCON)_",OCXDF("_(+OCXDF)_"))")
.;
.;
.M ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=OCXFCODE
;
D BLDDF^OCXOCMPH
;
Q OCXWARN
;
DBLQT(X) ;
N A,C F A=35:1:126,0 I A S C=$C(A) Q:'(X[C)
Q:'A X S C=$C(C) S X=$TR(X,"""",C) F Q:'(X[C) S X=$P(X,C,1)_""""""_$P(X,C,2,999)
Q X
;
FILECODE(OCXCON,CODE,OPLIST) ;
;
N OCXNDX S OCXNDX=$O(OCXFCODE(OCXCON,9999),-1)+1,OCXFCODE(OCXCON,OCXNDX)=CODE
S:$L($G(OPLIST)) OCXFCODE(OCXCON,OCXNDX,"OPLIST")=OPLIST
Q
;
UDEFPARM(PARM) ;
Q:$D(OCXPARM(PARM)) 0
D WARN^OCXOCMPV(" '"_PARM_"' parameter missing, in MetaDictionary link file.",4,OCXDF,$P($T(+1)," ",1)) Q 1
;
GETPARM(FILE,INST,PARM) ;
Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
N OCXP,OCXP1,OCXI,OCXGL
S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
Q:'$D(@OCXGL@(+FILE,0)) ""
I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
Q:'OCXP ""
I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
Q:'OCXI "" S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) Q:'OCXP1 ""
Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMP1 7504 printed Dec 13, 2024@02:24:38 Page 2
OCXOCMP1 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Data Field Navigation Code) ;12/22/98 13:37
+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 if $GET(OCXWARN)
QUIT OCXWARN
+3 SET OCXDF=0
FOR
SET OCXDF=$ORDER(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF))
if 'OCXDF
QUIT
Begin DoDot:1
+4 NEW OCXGETC,OCXGETN,OCXCOD2,OCXERR,OCXNAM,OCXPARM
+5 NEW OCXPATH,OCXCON,OCXFCODE,OCXDPTR,OCXREC,OCXATT
+6 KILL OCXREC(4)
MERGE OCXREC(4)=^OCXS(860.4,OCXDF)
+7 SET OCXNAM=$PIECE($GET(OCXREC(4,0)),U,1)
if '$LENGTH(OCXNAM)
QUIT
+8 SET OCXCON=0
FOR
SET OCXCON=$ORDER(OCXREC(4,"LINK",OCXCON))
if 'OCXCON
QUIT
Begin DoDot:2
+9 KILL OCXREC(6)
MERGE OCXREC(6)=^OCXS(860.6,OCXCON)
+10 SET OCXCONN=$PIECE($GET(OCXREC(6,0)),U,1)
IF '$LENGTH(OCXCONN)
DO WARN^OCXOCMPV("Data context IEN #"_(+OCXCON)_" not defined in Data Context file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+11 SET OCXCONA=$PIECE($GET(OCXREC(6,0)),U,2)
IF '$LENGTH(OCXCONA)
DO WARN^OCXOCMPV("Data context abbreviation for '"_OCXCONN_"' not defined in Data Context file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+12 SET OCXPATH=$GET(OCXREC(4,"LINK",OCXCON,"DATAPATH"))
IF '$LENGTH(OCXPATH)
DO WARN^OCXOCMPV("Data Link-Path not defined",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+13 SET OCXLNK=$ORDER(^OCXS(863.3,"B",OCXPATH,0))
IF 'OCXLNK
DO WARN^OCXOCMPV("Data Link-Path '"_OCXPATH_"' not defined in Meta-Dictionary Link file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+14 SET OCXATT=$PIECE($GET(^OCXS(863.3,OCXLNK,0)),U,5)
IF 'OCXATT
DO WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' ("_OCXLNK_") not defined in Meta-Dictionary Attribute file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+15 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+16 SET $PIECE(OCXREC(4,0),U,3)=""
+17 FOR OCXPARM="OCXO EXTERNAL FUNCTION CALL","OCXO VARIABLE NAME","OCXO VT-BAR PIECE NUMBER","OCXO UP-ARROW PIECE NUMBER","OCXO SEMI-COLON PIECE NUMBER","OCXO HL7 SEGMENT ID","OCXO FILE POINTER"
Begin DoDot:3
+18 if '$ORDER(^OCXS(863.8,"B",OCXPARM,0))
QUIT
+19 SET OCXPARM(OCXPARM)=$$GETPARM(33,OCXPATH,OCXPARM)
IF '$LENGTH(OCXPARM(OCXPARM))
KILL OCXPARM(OCXPARM)
QUIT
End DoDot:3
+20 SET OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
+21 IF '$LENGTH(OCXDTYP)
DO WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type not defined in Meta-Dictionary Attribute file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+22 if 'OCXDTYP
SET OCXDTYP=$ORDER(^OCXS(864.1,"B",OCXDTYP,0))
SET OCXDTYPN=$PIECE($GET(^OCXS(864.1,+OCXDTYP,0)),U,1)
+23 IF '$LENGTH(OCXDTYPN)
DO WARN^OCXOCMPV("Data Link-Attribute '"_OCXPATH_"' Data Type '"_OCXDTYP_"' not defined in Meta-Dictionary Data Type file...",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT
+24 ;
+25 SET OCXFCODE(OCXCON,"AN")=OCXNAM
+26 SET OCXFCODE(OCXCON,"AV")="OCXDF("_(+OCXDF)_")"
+27 SET OCXFCODE(OCXCON,"CN")=OCXCONN
+28 SET OCXFCODE(OCXCON,"CA")=OCXCONA
+29 SET OCXFCODE(OCXCON,"DTYP","DATA TYPE INDEX")=OCXDTYP
+30 SET OCXFCODE(OCXCON,"DTYP","DATA TYPE NAME")=OCXDTYPN
+31 SET OCXFCODE(OCXCON,"DA MODE")=+$PIECE($GET(OCXREC(6,0)),U,3)
+32 ;
+33 SET $PIECE(^OCXS(860.4,OCXDF,0),U,3)=OCXDTYP
+34 if $GET(OCXERR)
QUIT
+35 ;
+36 IF $LENGTH($GET(OCXPARM("OCXO EXTERNAL FUNCTION CALL")))
Begin DoDot:3
+37 IF '$LENGTH($GET(OCXPARM("OCXO VARIABLE NAME")))
Begin DoDot:4
+38 IF ($EXTRACT(OCXPARM("OCXO EXTERNAL FUNCTION CALL"),1)="(")
SET OCXGETC=OCXPARM("OCXO EXTERNAL FUNCTION CALL")
+39 IF '$TEST
SET OCXGETC="$$"_OCXPARM("OCXO EXTERNAL FUNCTION CALL")
End DoDot:4
+40 IF $LENGTH($GET(OCXPARM("OCXO VARIABLE NAME")))
Begin DoDot:4
+41 IF (OCXTLOG)
IF ((OCXPARM("OCXO EXTERNAL FUNCTION CALL")?.8AN1"^"1.8AN1"(".E)!(OCXPARM("OCXO EXTERNAL FUNCTION CALL")?1.8AN1"(".E))
Begin DoDot:5
+42 NEW OCXX
+43 SET OCXX="S OCXOERR=$$TIMELOG(""O"","""_$PIECE(OCXPARM("OCXO EXTERNAL FUNCTION CALL")_"(","(",1)_""")"
+44 SET OCXX=OCXX_" D "_OCXPARM("OCXO EXTERNAL FUNCTION CALL")
+45 SET OCXX=OCXX_" S OCXOERR=$$TIMELOG(""I"","""_$PIECE(OCXPARM("OCXO EXTERNAL FUNCTION CALL")_"(","(",1)_""")"
+46 DO FILECODE(OCXCON,OCXX,"SDS")
End DoDot:5
IF 1
+47 IF '$TEST
DO FILECODE(OCXCON,"D "_OCXPARM("OCXO EXTERNAL FUNCTION CALL"),"D")
+48 SET OCXGETC=$GET(OCXPARM("OCXO VARIABLE NAME"))
End DoDot:4
End DoDot:3
+49 ;
+50 IF '$LENGTH($GET(OCXPARM("OCXO EXTERNAL FUNCTION CALL")))
Begin DoDot:3
+51 IF '$LENGTH($GET(OCXPARM("OCXO VARIABLE NAME")))
Begin DoDot:4
+52 DO WARN^OCXOCMPV("Not enough information in the MetaDictionary link file to generate navigation code.",4,OCXDF,$PIECE($TEXT(+1)," ",1))
SET OCXERR=1
QUIT
End DoDot:4
+53 IF $LENGTH($GET(OCXPARM("OCXO VARIABLE NAME")))
SET OCXGETC="$G("_$GET(OCXPARM("OCXO VARIABLE NAME"))_")"
End DoDot:3
+54 ;
+55 if OCXWARN
QUIT
+56 ;
+57 if $LENGTH($GET(OCXPARM("OCXO VT-BAR PIECE NUMBER")))
SET OCXGETC="$P("_OCXGETC_",""|"","_(OCXPARM("OCXO VT-BAR PIECE NUMBER")+1)_")"
+58 if $GET(OCXPARM("OCXO UP-ARROW PIECE NUMBER"))
SET OCXGETC="$P("_OCXGETC_",""^"","_OCXPARM("OCXO UP-ARROW PIECE NUMBER")_")"
+59 if $GET(OCXPARM("OCXO SEMI-COLON PIECE NUMBER"))
SET OCXGETC="$P("_OCXGETC_","";"","_OCXPARM("OCXO SEMI-COLON PIECE NUMBER")_")"
+60 ;
+61 IF ($LENGTH($GET(OCXPARM("OCXO FILE POINTER"))))
Begin DoDot:3
+62 NEW OCXX
SET OCXX=OCXPARM("OCXO FILE POINTER")
+63 IF (OCXX=(+OCXX))
SET OCXGETC="$$POINTER("_(+OCXX)_","_OCXGETC_")"
+64 IF '$TEST
SET OCXGETC="$$POINTER("""_(OCXX)_""","_OCXGETC_")"
End DoDot:3
+65 if (OCXDTYPN="DATE/TIME")
SET OCXGETC="$$DT2INT("_OCXGETC_")"
+66 if '$LENGTH(OCXGETC)
QUIT
+67 SET OCXFCODE(OCXCON,"G")=OCXGETC
+68 DO FILECODE(OCXCON,"S OCXDF("_(+OCXDF)_")="_OCXGETC)
+69 IF $GET(OCXTRACE)
Begin DoDot:3
+70 NEW OCXTXT
+71 IF $DATA(OCXPARM("OCXO VARIABLE NAME"))
Begin DoDot:4
+72 SET OCXTXT="W:$D("_OCXPARM("OCXO VARIABLE NAME")_") !,||LNTAG||,?30,""Data Field: "_$EXTRACT(OCXNAM,1,25)_" : "",?30,"" ("
+73 IF $DATA(OCXCONA)
SET OCXTXT=OCXTXT_" "_OCXCONA
+74 IF $DATA(OCXPARM("OCXO VARIABLE NAME"))
SET OCXTXT=OCXTXT_" "_$$DBLQT(OCXPARM("OCXO VARIABLE NAME"))
+75 IF $DATA(OCXPARM("OCXO HL7 SEGMENT ID"))
SET OCXTXT=OCXTXT_" "_OCXPARM("OCXO HL7 SEGMENT ID")
+76 IF $DATA(OCXPARM("OCXO VT-BAR PIECE NUMBER"))
SET OCXTXT=OCXTXT_" "_OCXPARM("OCXO VT-BAR PIECE NUMBER")
+77 IF $DATA(OCXPARM("OCXO UP-ARROW PIECE NUMBER"))
SET OCXTXT=OCXTXT_" piece "_OCXPARM("OCXO UP-ARROW PIECE NUMBER")
+78 IF (OCXDTYPN="DATE/TIME")
SET OCXTXT=OCXTXT_" ) "",$$INT2DT("_OCXGETC_",1)"
+79 IF '$TEST
IF (OCXDTYPN="BOOLEAN")
SET OCXTXT=OCXTXT_" ) "",$S(+"_OCXGETC_":""TRUE"",1:""FALSE"")"
+80 IF '$TEST
SET OCXTXT=OCXTXT_" ) "","_OCXGETC
+81 IF $LENGTH($GET(OCXPARM("OCXO HL7 SEGMENT ID")))
Begin DoDot:5
+82 SET ^TMP("OCXCMP",$JOB,"DATA FIELD TRACE","HL7",$GET(OCXPARM("OCXO HL7 SEGMENT ID")," "),+$GET(OCXPARM("OCXO VT-BAR PIECE NUMBER")),+$GET(OCXPARM("OCXO UP-ARROW PIECE NUMBER")),OCXDF)=OCXTXT
End DoDot:5
+83 IF '$TEST
SET ^TMP("OCXCMP",$JOB,"DATA FIELD TRACE",OCXCON,0,0,+$GET(OCXPARM("OCXO UP-ARROW PIECE NUMBER")),OCXDF)=OCXTXT
End DoDot:4
+84 ;
+85 DO FILECODE(OCXCON,"W:$G(OCXTRACE) !,||LNTAG||,?30,""Data Field: "_OCXNAM_" = """""",OCXDF("_(+OCXDF)_"),""""""""")
End DoDot:3
+86 IF 0
DO FILECODE(OCXCON,"S OCXOERR=$$LOGDF("_(+OCXDF)_","_(+OCXCON)_",OCXDF("_(+OCXDF)_"))")
End DoDot:2
if $GET(OCXWARN)
QUIT
+87 ;
+88 ;
+89 MERGE ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF)=OCXFCODE
End DoDot:1
if OCXWARN
QUIT
+90 ;
+91 DO BLDDF^OCXOCMPH
+92 ;
+93 QUIT OCXWARN
+94 ;
DBLQT(X) ;
+1 NEW A,C
FOR A=35:1:126,0
IF A
SET C=$CHAR(A)
if '(X[C)
QUIT
+2 if 'A
QUIT X
SET C=$CHAR(C)
SET X=$TRANSLATE(X,"""",C)
FOR
if '(X[C)
QUIT
SET X=$PIECE(X,C,1)_""""""_$PIECE(X,C,2,999)
+3 QUIT X
+4 ;
FILECODE(OCXCON,CODE,OPLIST) ;
+1 ;
+2 NEW OCXNDX
SET OCXNDX=$ORDER(OCXFCODE(OCXCON,9999),-1)+1
SET OCXFCODE(OCXCON,OCXNDX)=CODE
+3 if $LENGTH($GET(OPLIST))
SET OCXFCODE(OCXCON,OCXNDX,"OPLIST")=OPLIST
+4 QUIT
+5 ;
UDEFPARM(PARM) ;
+1 if $DATA(OCXPARM(PARM))
QUIT 0
+2 DO WARN^OCXOCMPV(" '"_PARM_"' parameter missing, in MetaDictionary link file.",4,OCXDF,$PIECE($TEXT(+1)," ",1))
QUIT 1
+3 ;
GETPARM(FILE,INST,PARM) ;
+1 if '$LENGTH(FILE)
QUIT ""
if '$LENGTH(INST)
QUIT ""
if '$LENGTH(PARM)
QUIT ""
+2 NEW OCXP,OCXP1,OCXI,OCXGL
+3 SET OCXGL="^OCXS"
if (FILE=1)
SET OCXGL="^OCXD"
if (FILE=7)
SET OCXGL="^OCXD"
if (FILE=10)
SET OCXGL="^OCXD"
SET FILE=FILE/10+860
+4 if '$DATA(@OCXGL@(+FILE,0))
QUIT ""
+5 IF (PARM=+PARM)
IF $DATA(^OCXS(863.8,PARM,0))
SET OCXP=PARM
+6 IF '$TEST
SET OCXP=$ORDER(^OCXS(863.8,"B",PARM,0))
+7 if 'OCXP
QUIT ""
+8 IF (INST=+INST)
IF $DATA(@OCXGL@(FILE,INST,0))
SET OCXI=INST
+9 IF '$TEST
SET OCXI=$ORDER(@OCXGL@(FILE,"B",INST,0))
+10 if 'OCXI
QUIT ""
SET OCXP1=$ORDER(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0))
if 'OCXP1
QUIT ""
+11 QUIT $GET(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
+12 ;
