- 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 Feb 18, 2025@23:51:11 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 ;