[613] | 1 | OCXOCMP1 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Data Field Navigation Code) ;12/22/98 13:37
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
---|
| 3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
| 4 | ;
|
---|
| 5 | EN() ;
|
---|
| 6 | ;
|
---|
| 7 | Q:$G(OCXWARN) OCXWARN
|
---|
| 8 | S OCXDF=0 F S OCXDF=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) Q:'OCXDF D Q:OCXWARN
|
---|
| 9 | .N OCXGETC,OCXGETN,OCXCOD2,OCXERR,OCXNAM,OCXPARM
|
---|
| 10 | .N OCXPATH,OCXCON,OCXFCODE,OCXDPTR,OCXREC,OCXATT
|
---|
| 11 | .K OCXREC(4) M OCXREC(4)=^OCXS(860.4,OCXDF)
|
---|
| 12 | .S OCXNAM=$P($G(OCXREC(4,0)),U,1) Q:'$L(OCXNAM)
|
---|
| 13 | .S OCXCON=0 F S OCXCON=$O(OCXREC(4,"LINK",OCXCON)) Q:'OCXCON D Q:$G(OCXWARN)
|
---|
| 14 | ..K OCXREC(6) M OCXREC(6)=^OCXS(860.6,OCXCON)
|
---|
| 15 | ..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
|
---|
| 16 | ..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
|
---|
| 17 | ..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
|
---|
| 18 | ..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
|
---|
| 19 | ..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
|
---|
| 20 | ..I '$G(OCXAUTO) W:($X>60) ! W "."
|
---|
| 21 | ..S $P(OCXREC(4,0),U,3)=""
|
---|
| 22 | ..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
|
---|
| 23 | ...Q:'$O(^OCXS(863.8,"B",OCXPARM,0))
|
---|
| 24 | ...S OCXPARM(OCXPARM)=$$GETPARM(33,OCXPATH,OCXPARM) I '$L(OCXPARM(OCXPARM)) K OCXPARM(OCXPARM) Q
|
---|
| 25 | ..S OCXDTYP=$$GETPARM(34,OCXATT,"DATA TYPE")
|
---|
| 26 | ..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
|
---|
| 27 | ..S:'OCXDTYP OCXDTYP=$O(^OCXS(864.1,"B",OCXDTYP,0)) S OCXDTYPN=$P($G(^OCXS(864.1,+OCXDTYP,0)),U,1)
|
---|
| 28 | ..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
|
---|
| 29 | ..;
|
---|
| 30 | ..S OCXFCODE(OCXCON,"AN")=OCXNAM
|
---|
| 31 | ..S OCXFCODE(OCXCON,"AV")="OCXDF("_(+OCXDF)_")"
|
---|
| 32 | ..S OCXFCODE(OCXCON,"CN")=OCXCONN
|
---|
| 33 | ..S OCXFCODE(OCXCON,"CA")=OCXCONA
|
---|
| 34 | ..S OCXFCODE(OCXCON,"DTYP","DATA TYPE INDEX")=OCXDTYP
|
---|
| 35 | ..S OCXFCODE(OCXCON,"DTYP","DATA TYPE NAME")=OCXDTYPN
|
---|
| 36 | ..S OCXFCODE(OCXCON,"DA MODE")=+$P($G(OCXREC(6,0)),U,3)
|
---|
| 37 | ..;
|
---|
| 38 | ..S $P(^OCXS(860.4,OCXDF,0),U,3)=OCXDTYP
|
---|
| 39 | ..Q:$G(OCXERR)
|
---|
| 40 | ..;
|
---|
| 41 | ..I $L($G(OCXPARM("OCXO EXTERNAL FUNCTION CALL"))) D
|
---|
| 42 | ...I '$L($G(OCXPARM("OCXO VARIABLE NAME"))) D
|
---|
| 43 | ....I ($E(OCXPARM("OCXO EXTERNAL FUNCTION CALL"),1)="(") S OCXGETC=OCXPARM("OCXO EXTERNAL FUNCTION CALL")
|
---|
| 44 | ....E S OCXGETC="$$"_OCXPARM("OCXO EXTERNAL FUNCTION CALL")
|
---|
| 45 | ...I $L($G(OCXPARM("OCXO VARIABLE NAME"))) D
|
---|
| 46 | ....I (OCXTLOG),((OCXPARM("OCXO EXTERNAL FUNCTION CALL")?.8AN1"^"1.8AN1"(".E)!(OCXPARM("OCXO EXTERNAL FUNCTION CALL")?1.8AN1"(".E)) D I 1
|
---|
| 47 | .....N OCXX
|
---|
| 48 | .....S OCXX="S OCXOERR=$$TIMELOG(""O"","""_$P(OCXPARM("OCXO EXTERNAL FUNCTION CALL")_"(","(",1)_""")"
|
---|
| 49 | .....S OCXX=OCXX_" D "_OCXPARM("OCXO EXTERNAL FUNCTION CALL")
|
---|
| 50 | .....S OCXX=OCXX_" S OCXOERR=$$TIMELOG(""I"","""_$P(OCXPARM("OCXO EXTERNAL FUNCTION CALL")_"(","(",1)_""")"
|
---|
| 51 | .....D FILECODE(OCXCON,OCXX,"SDS")
|
---|
| 52 | ....E D FILECODE(OCXCON,"D "_OCXPARM("OCXO EXTERNAL FUNCTION CALL"),"D")
|
---|
| 53 | ....S OCXGETC=$G(OCXPARM("OCXO VARIABLE NAME"))
|
---|
| 54 | ..;
|
---|
| 55 | ..I '$L($G(OCXPARM("OCXO EXTERNAL FUNCTION CALL"))) D
|
---|
| 56 | ...I '$L($G(OCXPARM("OCXO VARIABLE NAME"))) D
|
---|
| 57 | ....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
|
---|
| 58 | ...I $L($G(OCXPARM("OCXO VARIABLE NAME"))) S OCXGETC="$G("_$G(OCXPARM("OCXO VARIABLE NAME"))_")"
|
---|
| 59 | ..;
|
---|
| 60 | ..Q:OCXWARN
|
---|
| 61 | ..;
|
---|
| 62 | ..S:$L($G(OCXPARM("OCXO VT-BAR PIECE NUMBER"))) OCXGETC="$P("_OCXGETC_",""|"","_(OCXPARM("OCXO VT-BAR PIECE NUMBER")+1)_")"
|
---|
| 63 | ..S:$G(OCXPARM("OCXO UP-ARROW PIECE NUMBER")) OCXGETC="$P("_OCXGETC_",""^"","_OCXPARM("OCXO UP-ARROW PIECE NUMBER")_")"
|
---|
| 64 | ..S:$G(OCXPARM("OCXO SEMI-COLON PIECE NUMBER")) OCXGETC="$P("_OCXGETC_","";"","_OCXPARM("OCXO SEMI-COLON PIECE NUMBER")_")"
|
---|
| 65 | ..;
|
---|
| 66 | ..I ($L($G(OCXPARM("OCXO FILE POINTER")))) D
|
---|
| 67 | ...N OCXX S OCXX=OCXPARM("OCXO FILE POINTER")
|
---|
| 68 | ...I (OCXX=(+OCXX)) S OCXGETC="$$POINTER("_(+OCXX)_","_OCXGETC_")"
|
---|
| 69 | ...E S OCXGETC="$$POINTER("""_(OCXX)_""","_OCXGETC_")"
|
---|
| 70 | ..S:(OCXDTYPN="DATE/TIME") OCXGETC="$$DT2INT("_OCXGETC_")"
|
---|
| 71 | ..Q:'$L(OCXGETC)
|
---|
| 72 | ..S OCXFCODE(OCXCON,"G")=OCXGETC
|
---|
| 73 | ..D FILECODE(OCXCON,"S OCXDF("_(+OCXDF)_")="_OCXGETC)
|
---|
| 74 | ..I $G(OCXTRACE) D
|
---|
| 75 | ...N OCXTXT
|
---|
| 76 | ...I $D(OCXPARM("OCXO VARIABLE NAME")) D
|
---|
| 77 | ....S OCXTXT="W:$D("_OCXPARM("OCXO VARIABLE NAME")_") !,||LNTAG||,?30,""Data Field: "_$E(OCXNAM,1,25)_" : "",?30,"" ("
|
---|
| 78 | ....I $D(OCXCONA) S OCXTXT=OCXTXT_" "_OCXCONA
|
---|
| 79 | ....I $D(OCXPARM("OCXO VARIABLE NAME")) S OCXTXT=OCXTXT_" "_$$DBLQT(OCXPARM("OCXO VARIABLE NAME"))
|
---|
| 80 | ....I $D(OCXPARM("OCXO HL7 SEGMENT ID")) S OCXTXT=OCXTXT_" "_OCXPARM("OCXO HL7 SEGMENT ID")
|
---|
| 81 | ....I $D(OCXPARM("OCXO VT-BAR PIECE NUMBER")) S OCXTXT=OCXTXT_" "_OCXPARM("OCXO VT-BAR PIECE NUMBER")
|
---|
| 82 | ....I $D(OCXPARM("OCXO UP-ARROW PIECE NUMBER")) S OCXTXT=OCXTXT_" piece "_OCXPARM("OCXO UP-ARROW PIECE NUMBER")
|
---|
| 83 | ....I (OCXDTYPN="DATE/TIME") S OCXTXT=OCXTXT_" ) "",$$INT2DT("_OCXGETC_",1)"
|
---|
| 84 | ....E I (OCXDTYPN="BOOLEAN") S OCXTXT=OCXTXT_" ) "",$S(+"_OCXGETC_":""TRUE"",1:""FALSE"")"
|
---|
| 85 | ....E S OCXTXT=OCXTXT_" ) "","_OCXGETC
|
---|
| 86 | ....I $L($G(OCXPARM("OCXO HL7 SEGMENT ID"))) D
|
---|
| 87 | .....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
|
---|
| 88 | ....E S ^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXCON,0,0,+$G(OCXPARM("OCXO UP-ARROW PIECE NUMBER")),OCXDF)=OCXTXT
|
---|
| 89 | ...;
|
---|
| 90 | ...D FILECODE(OCXCON,"W:$G(OCXTRACE) !,||LNTAG||,?30,""Data Field: "_OCXNAM_" = """""",OCXDF("_(+OCXDF)_"),""""""""")
|
---|
| 91 | ..I 0 D FILECODE(OCXCON,"S OCXOERR=$$LOGDF("_(+OCXDF)_","_(+OCXCON)_",OCXDF("_(+OCXDF)_"))")
|
---|
| 92 | .;
|
---|
| 93 | .;
|
---|
| 94 | .M ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=OCXFCODE
|
---|
| 95 | ;
|
---|
| 96 | D BLDDF^OCXOCMPH
|
---|
| 97 | ;
|
---|
| 98 | Q OCXWARN
|
---|
| 99 | ;
|
---|
| 100 | DBLQT(X) ;
|
---|
| 101 | N A,C F A=35:1:126,0 I A S C=$C(A) Q:'(X[C)
|
---|
| 102 | 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)
|
---|
| 103 | Q X
|
---|
| 104 | ;
|
---|
| 105 | FILECODE(OCXCON,CODE,OPLIST) ;
|
---|
| 106 | ;
|
---|
| 107 | N OCXNDX S OCXNDX=$O(OCXFCODE(OCXCON,9999),-1)+1,OCXFCODE(OCXCON,OCXNDX)=CODE
|
---|
| 108 | S:$L($G(OPLIST)) OCXFCODE(OCXCON,OCXNDX,"OPLIST")=OPLIST
|
---|
| 109 | Q
|
---|
| 110 | ;
|
---|
| 111 | UDEFPARM(PARM) ;
|
---|
| 112 | Q:$D(OCXPARM(PARM)) 0
|
---|
| 113 | D WARN^OCXOCMPV(" '"_PARM_"' parameter missing, in MetaDictionary link file.",4,OCXDF,$P($T(+1)," ",1)) Q 1
|
---|
| 114 | ;
|
---|
| 115 | GETPARM(FILE,INST,PARM) ;
|
---|
| 116 | Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
|
---|
| 117 | N OCXP,OCXP1,OCXI,OCXGL
|
---|
| 118 | S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
|
---|
| 119 | Q:'$D(@OCXGL@(+FILE,0)) ""
|
---|
| 120 | I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
|
---|
| 121 | E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
|
---|
| 122 | Q:'OCXP ""
|
---|
| 123 | I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
|
---|
| 124 | E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
|
---|
| 125 | Q:'OCXI "" S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) Q:'OCXP1 ""
|
---|
| 126 | Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
|
---|
| 127 | ;
|
---|