OCXOED13 ;SLC/RJS,CLA - Rule Editor (Meta Dictionary Link Display) ;10/29/98 12:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
;
S ;
;
Q
EN(OCXLNK,OCXSRC) ;
;
N OCXACT,OCXRD
S OCXD0=+$$DIC("^OCXS(863.3,","XM","",OCXLNK)
I '(OCXD0>0) S OCXD0=$$ADDLINK(OCXLNK,OCXSRC) Q:'OCXD0
F K OCXRD,OCXACT S (OCXRD,OCXACT)="" D DISP(OCXD0,.OCXRD,.OCXACT) Q:$$EN^OCXOED14(OCXD0,.OCXRD,.OCXACT)
;
Q
;
DISP(OCXD0,OCXRD,OCXACT) ;
;
N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
S OCXTNLN=$C(27,91,48,109),OCXTRLN=$C(27,91,55,109),OCXTULN=$C(27,91,52,109),OCXTHLN=$C(27,91,49,109)
D GETDATA(OCXD0,.OCXRD)
D CHKVR(OCXD0,.OCXRD)
;
W @IOF,OCXTNLN
W !,$$CENTER($$FIELD("Meta Dictionary Edit Screen"),80),!
W !," ",$$FIELD("Link:")," ",$$DATA($G(OCXRD("LINK",OCXD0,.01,"E")),50)
W !," ",$$FIELD(" Subject:")," ",$$DATA($G(OCXRD("LINK",OCXD0,.02,"E")),50)
W !," ",$$OPT^OCXOEDT("Change Attribute","EDATT","14",.OCXACT,OCXD0,"CA")
W " ",$$FIELD(" Attribute:")," ",$$DATA($G(OCXRD("LINK",OCXD0,.05,"E")),50)
;
W !!,$$SEP("Parameters"),!
;
W !," ",$$OPT^OCXOEDT("P1","EDPARAM","14",.OCXACT,OCXD0_",""OCXO EXTERNAL FUNCTION CALL""")
W " ",$$FIELD(" M Function Call: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO EXTERNAL FUNCTION CALL"),30)
W !," ",$$OPT^OCXOEDT("P2","EDPARAM","14",.OCXACT,OCXD0_",""OCXO VARIABLE NAME""")
W " ",$$FIELD(" Data Variable Name: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO VARIABLE NAME"),30)
W !," ",$$OPT^OCXOEDT("P3","EDPARAM","14",.OCXACT,OCXD0_",""OCXO VT-BAR PIECE NUMBER""")
W " ",$$FIELD(" Vertical Bar '|' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO VT-BAR PIECE NUMBER"),30)
W !," ",$$OPT^OCXOEDT("P4","EDPARAM","14",.OCXACT,OCXD0_",""OCXO UP-ARROW PIECE NUMBER""")
W " ",$$FIELD(" Up Arrow '^' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO UP-ARROW PIECE NUMBER"),30)
W !," ",$$OPT^OCXOEDT("P5","EDPARAM","14",.OCXACT,OCXD0_",""OCXO SEMI-COLON PIECE NUMBER""")
W " ",$$FIELD(" Semi Colon ';' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO SEMI-COLON PIECE NUMBER"),30)
W !," ",$$OPT^OCXOEDT("P6","EDPARAM","14",.OCXACT,OCXD0_",""OCXO FILE POINTER""")
W " ",$$FIELD(" Pointed To File Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO FILE POINTER"),30)
W !," ",$$OPT^OCXOEDT("P7","EDPARAM","14",.OCXACT,OCXD0_",""OCXO HL7 SEGMENT ID""")
W " ",$$FIELD(" HL7 Segment ID: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO HL7 SEGMENT ID"),30)
I +$G(OCXRD("LINK",OCXD0,.05,"I")) D
.W !!," ",$$OPT^OCXOEDT("Data Type","EDPATT","14",.OCXACT,(+$G(OCXRD("LINK",OCXD0,.05,"I")))_",""DATA TYPE""","DT")
.W " ",$$FIELD(" Attribute Data Type: ")," ",$$DATA($$PVAL("ATT",+$G(OCXRD("LINK",OCXD0,.05,"I")),"DATA TYPE"),30)
;
Q
;
PVAL(SUB,OCXD0,PNAME) ;
N X S X="" F S X=$O(OCXRD(SUB,OCXD0,"PAR",X)) Q:'X I ($G(OCXRD(SUB,OCXD0,"PAR",X,.01,"E"))=PNAME) Q
Q:'X "" Q $G(OCXRD(SUB,OCXD0,"PAR",X,1,"E"))
;
CHKVR(OCXD0,OCXRD) ;
;
N OCXVNM,OCXSID,OCXVPN
;
S OCXVNM=$$PVAL("LINK",OCXD0,"OCXO VARIABLE NAME")
S OCXVPN=$$PVAL("LINK",OCXD0,"OCXO VT-BAR PIECE NUMBER")
S OCXSID=$$PVAL("LINK",OCXD0,"OCXO HL7 SEGMENT ID")
;
;
I '$L(OCXVNM),$L(OCXVPN),$L(OCXSID) D
.N OCXVAR S OCXVAR="OCXODATA("""_OCXSID_""","_OCXVPN_")"
.D SLPVAL^OCXOED14(OCXD0,"OCXO VARIABLE NAME",OCXVAR)
.D SLPVAL^OCXOED14(OCXD0,"OCXO VT-BAR PIECE NUMBER","@")
.D SLPVAL^OCXOED14(OCXD0,"OCXO HL7 SEGMENT ID","@")
.K OCXRD S OCXRD="" D GETDATA(OCXD0,.OCXRD)
Q
;
Q
CENTER(X,M) ;
N SP S SP="",$P(SP," ",80)=" " Q $E(SP,1,((M\2)-($L(X)\2)))_X
;
SEP(OCXHDR) ;
;
N SPACES S SPACES="",$P(SPACES," ",80-$L(OCXHDR))=" " Q OCXTNLN_OCXTHLN_OCXTULN_$G(OCXHDR)_SPACES_OCXTNLN
;
FIELD(OCXHDR) ;
;
Q OCXTHLN_$G(OCXHDR)_OCXTNLN
;
DATA(OCXVAL,OCXLEN) ;
;
N SPACES S SPACES="",$P(SPACES," ",OCXLEN+5)=" ",OCXVAL=$G(OCXVAL)
I ($L(OCXVAL)>OCXLEN) Q $E(OCXVAL,1,OCXLEN-3)_"..."
Q $E((OCXVAL_SPACES),1,OCXLEN)
;
GETDATA(OCXD0,OCXD) ;
;
N OCXDIQ,OCXX,OCXATT,OCXSUB
;
S OCXDIQ="" D DIQ("^OCXS(863.3,",OCXD0,"IEN",.OCXDIQ)
M OCXD("LINK")=OCXDIQ(863.3) K OCXDIQ S OCXDIQ=""
S OCXX=0 F S OCXX=$O(^OCXS(863.3,OCXD0,"PAR",OCXX)) Q:'OCXX W "." D
.S OCXDIQ="" D DIQ("^OCXS(863.3,"_OCXD0_",""PAR"",",OCXX,"IEN",.OCXDIQ)
.M OCXD("LINK",OCXD0,"PAR")=OCXDIQ(863.32) K OCXDIQ S OCXDIQ=""
;
S OCXDIQ="",OCXSUB=$G(OCXD("LINK",OCXD0,.02,"I")) I OCXSUB D
.D DIQ("^OCXS(863.2,",OCXSUB,"IEN",.OCXDIQ)
.M OCXD("SUB")=OCXDIQ(863.2) K OCXDIQ S OCXDIQ=""
;
S OCXDIQ="",OCXATT=$G(OCXD("LINK",OCXD0,.05,"I")) I OCXATT D
.D DIQ("^OCXS(863.4,",OCXATT,"IEN",.OCXDIQ)
.M OCXD("ATT")=OCXDIQ(863.4) K OCXDIQ S OCXDIQ=""
.S OCXX=0 F S OCXX=$O(^OCXS(863.4,OCXATT,"PAR",OCXX)) Q:'OCXX W "." D
..S OCXDIQ="" D DIQ("^OCXS(863.4,"_OCXATT_",""PAR"",",OCXX,"IEN",.OCXDIQ)
..M OCXD("ATT",OCXATT,"PAR")=OCXDIQ(863.41) K OCXDIQ S OCXDIQ=""
Q
;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;
;
N DIC,X,Y
S DIC=$G(OCXDIC) Q:'$L(DIC) -1
S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
S:$L($G(OCXDICS)) DIC("S")=OCXDICS
S:$L($G(OCXDICA)) DIC("A")=OCXDICA
S:$L($G(OCXDR)) DIC("DR")=OCXDR
D ^DIC Q:(Y<1) 0 Q Y
;
DIQ(DIC,DA,OCXDIQ0,OCXARY) ;
N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)=$G(OCXDIQ0)
D EN^DIQ1
Q
;
ADDLINK(OCXNAME,OCXSRC) ;
N OCXD0,OCXDR
S OCXD0=+$$DIC("^OCXS(863.2,","XLME","",$P(OCXNAME,".",1)) Q:(OCXD0<1) 0
S OCXDR=".02///"_$P(OCXNAME,".",1)_";.04///"_OCXSRC_";.06///99"
S OCXD0=+$$DIC("^OCXS(863.3,","XLME","",OCXNAME,"",OCXDR)
Q:(OCXD0<1) 0 Q OCXD0
;
OCXOED13 ;SLC/RJS,CLA - Rule Editor (Meta Dictionary Link Display) ;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ;
S ;
+1 ;
+2 QUIT
EN(OCXLNK,OCXSRC) ;
+1 ;
+2 NEW OCXACT,OCXRD
+3 SET OCXD0=+$$DIC("^OCXS(863.3,","XM","",OCXLNK)
+4 IF '(OCXD0>0)
SET OCXD0=$$ADDLINK(OCXLNK,OCXSRC)
IF 'OCXD0
QUIT
+5 FOR
KILL OCXRD,OCXACT
SET (OCXRD,OCXACT)=""
DO DISP(OCXD0,.OCXRD,.OCXACT)
IF $$EN^OCXOED14(OCXD0,.OCXRD,.OCXACT)
QUIT
+6 ;
+7 QUIT
+8 ;
DISP(OCXD0,OCXRD,OCXACT) ;
+1 ;
+2 NEW OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
+3 SET OCXTNLN=$CHAR(27,91,48,109)
SET OCXTRLN=$CHAR(27,91,55,109)
SET OCXTULN=$CHAR(27,91,52,109)
SET OCXTHLN=$CHAR(27,91,49,109)
+4 DO GETDATA(OCXD0,.OCXRD)
+5 DO CHKVR(OCXD0,.OCXRD)
+6 ;
+7 WRITE @IOF,OCXTNLN
+8 WRITE !,$$CENTER($$FIELD("Meta Dictionary Edit Screen"),80),!
+9 WRITE !," ",$$FIELD("Link:")," ",$$DATA($GET(OCXRD("LINK",OCXD0,.01,"E")),50)
+10 WRITE !," ",$$FIELD(" Subject:")," ",$$DATA($GET(OCXRD("LINK",OCXD0,.02,"E")),50)
+11 WRITE !," ",$$OPT^OCXOEDT("Change Attribute","EDATT","14",.OCXACT,OCXD0,"CA")
+12 WRITE " ",$$FIELD(" Attribute:")," ",$$DATA($GET(OCXRD("LINK",OCXD0,.05,"E")),50)
+13 ;
+14 WRITE !!,$$SEP("Parameters"),!
+15 ;
+16 WRITE !," ",$$OPT^OCXOEDT("P1","EDPARAM","14",.OCXACT,OCXD0_",""OCXO EXTERNAL FUNCTION CALL""")
+17 WRITE " ",$$FIELD(" M Function Call: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO EXTERNAL FUNCTION CALL"),30)
+18 WRITE !," ",$$OPT^OCXOEDT("P2","EDPARAM","14",.OCXACT,OCXD0_",""OCXO VARIABLE NAME""")
+19 WRITE " ",$$FIELD(" Data Variable Name: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO VARIABLE NAME"),30)
+20 WRITE !," ",$$OPT^OCXOEDT("P3","EDPARAM","14",.OCXACT,OCXD0_",""OCXO VT-BAR PIECE NUMBER""")
+21 WRITE " ",$$FIELD(" Vertical Bar '|' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO VT-BAR PIECE NUMBER"),30)
+22 WRITE !," ",$$OPT^OCXOEDT("P4","EDPARAM","14",.OCXACT,OCXD0_",""OCXO UP-ARROW PIECE NUMBER""")
+23 WRITE " ",$$FIELD(" Up Arrow '^' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO UP-ARROW PIECE NUMBER"),30)
+24 WRITE !," ",$$OPT^OCXOEDT("P5","EDPARAM","14",.OCXACT,OCXD0_",""OCXO SEMI-COLON PIECE NUMBER""")
+25 WRITE " ",$$FIELD(" Semi Colon ';' Piece Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO SEMI-COLON PIECE NUMBER"),30)
+26 WRITE !," ",$$OPT^OCXOEDT("P6","EDPARAM","14",.OCXACT,OCXD0_",""OCXO FILE POINTER""")
+27 WRITE " ",$$FIELD(" Pointed To File Number: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO FILE POINTER"),30)
+28 WRITE !," ",$$OPT^OCXOEDT("P7","EDPARAM","14",.OCXACT,OCXD0_",""OCXO HL7 SEGMENT ID""")
+29 WRITE " ",$$FIELD(" HL7 Segment ID: ")," ",$$DATA($$PVAL("LINK",OCXD0,"OCXO HL7 SEGMENT ID"),30)
+30 IF +$GET(OCXRD("LINK",OCXD0,.05,"I"))
Begin DoDot:1
+31 WRITE !!," ",$$OPT^OCXOEDT("Data Type","EDPATT","14",.OCXACT,(+$GET(OCXRD("LINK",OCXD0,.05,"I")))_",""DATA TYPE""","DT")
+32 WRITE " ",$$FIELD(" Attribute Data Type: ")," ",$$DATA($$PVAL("ATT",+$GET(OCXRD("LINK",OCXD0,.05,"I")),"DATA TYPE"),30)
End DoDot:1
+33 ;
+34 QUIT
+35 ;
PVAL(SUB,OCXD0,PNAME) ;
+1 NEW X
SET X=""
FOR
SET X=$ORDER(OCXRD(SUB,OCXD0,"PAR",X))
IF 'X
QUIT
IF ($GET(OCXRD(SUB,OCXD0,"PAR",X,.01,"E"))=PNAME)
QUIT
+2 IF 'X
QUIT ""
QUIT $GET(OCXRD(SUB,OCXD0,"PAR",X,1,"E"))
+3 ;
CHKVR(OCXD0,OCXRD) ;
+1 ;
+2 NEW OCXVNM,OCXSID,OCXVPN
+3 ;
+4 SET OCXVNM=$$PVAL("LINK",OCXD0,"OCXO VARIABLE NAME")
+5 SET OCXVPN=$$PVAL("LINK",OCXD0,"OCXO VT-BAR PIECE NUMBER")
+6 SET OCXSID=$$PVAL("LINK",OCXD0,"OCXO HL7 SEGMENT ID")
+7 ;
+8 ;
+9 IF '$LENGTH(OCXVNM)
IF $LENGTH(OCXVPN)
IF $LENGTH(OCXSID)
Begin DoDot:1
+10 NEW OCXVAR
SET OCXVAR="OCXODATA("""_OCXSID_""","_OCXVPN_")"
+11 DO SLPVAL^OCXOED14(OCXD0,"OCXO VARIABLE NAME",OCXVAR)
+12 DO SLPVAL^OCXOED14(OCXD0,"OCXO VT-BAR PIECE NUMBER","@")
+13 DO SLPVAL^OCXOED14(OCXD0,"OCXO HL7 SEGMENT ID","@")
+14 KILL OCXRD
SET OCXRD=""
DO GETDATA(OCXD0,.OCXRD)
End DoDot:1
+15 QUIT
+16 ;
+17 QUIT
CENTER(X,M) ;
+1 NEW SP
SET SP=""
SET $PIECE(SP," ",80)=" "
QUIT $EXTRACT(SP,1,((M\2)-($LENGTH(X)\2)))_X
+2 ;
SEP(OCXHDR) ;
+1 ;
+2 NEW SPACES
SET SPACES=""
SET $PIECE(SPACES," ",80-$LENGTH(OCXHDR))=" "
QUIT OCXTNLN_OCXTHLN_OCXTULN_$GET(OCXHDR)_SPACES_OCXTNLN
+3 ;
FIELD(OCXHDR) ;
+1 ;
+2 QUIT OCXTHLN_$GET(OCXHDR)_OCXTNLN
+3 ;
DATA(OCXVAL,OCXLEN) ;
+1 ;
+2 NEW SPACES
SET SPACES=""
SET $PIECE(SPACES," ",OCXLEN+5)=" "
SET OCXVAL=$GET(OCXVAL)
+3 IF ($LENGTH(OCXVAL)>OCXLEN)
QUIT $EXTRACT(OCXVAL,1,OCXLEN-3)_"..."
+4 QUIT $EXTRACT((OCXVAL_SPACES),1,OCXLEN)
+5 ;
GETDATA(OCXD0,OCXD) ;
+1 ;
+2 NEW OCXDIQ,OCXX,OCXATT,OCXSUB
+3 ;
+4 SET OCXDIQ=""
DO DIQ("^OCXS(863.3,",OCXD0,"IEN",.OCXDIQ)
+5 MERGE OCXD("LINK")=OCXDIQ(863.3)
KILL OCXDIQ
SET OCXDIQ=""
+6 SET OCXX=0
FOR
SET OCXX=$ORDER(^OCXS(863.3,OCXD0,"PAR",OCXX))
IF 'OCXX
QUIT
WRITE "."
Begin DoDot:1
+7 SET OCXDIQ=""
DO DIQ("^OCXS(863.3,"_OCXD0_",""PAR"",",OCXX,"IEN",.OCXDIQ)
+8 MERGE OCXD("LINK",OCXD0,"PAR")=OCXDIQ(863.32)
KILL OCXDIQ
SET OCXDIQ=""
End DoDot:1
+9 ;
+10 SET OCXDIQ=""
SET OCXSUB=$GET(OCXD("LINK",OCXD0,.02,"I"))
IF OCXSUB
Begin DoDot:1
+11 DO DIQ("^OCXS(863.2,",OCXSUB,"IEN",.OCXDIQ)
+12 MERGE OCXD("SUB")=OCXDIQ(863.2)
KILL OCXDIQ
SET OCXDIQ=""
End DoDot:1
+13 ;
+14 SET OCXDIQ=""
SET OCXATT=$GET(OCXD("LINK",OCXD0,.05,"I"))
IF OCXATT
Begin DoDot:1
+15 DO DIQ("^OCXS(863.4,",OCXATT,"IEN",.OCXDIQ)
+16 MERGE OCXD("ATT")=OCXDIQ(863.4)
KILL OCXDIQ
SET OCXDIQ=""
+17 SET OCXX=0
FOR
SET OCXX=$ORDER(^OCXS(863.4,OCXATT,"PAR",OCXX))
IF 'OCXX
QUIT
WRITE "."
Begin DoDot:2
+18 SET OCXDIQ=""
DO DIQ("^OCXS(863.4,"_OCXATT_",""PAR"",",OCXX,"IEN",.OCXDIQ)
+19 MERGE OCXD("ATT",OCXATT,"PAR")=OCXDIQ(863.41)
KILL OCXDIQ
SET OCXDIQ=""
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;
+1 ;
+2 NEW DIC,X,Y
+3 SET DIC=$GET(OCXDIC)
IF '$LENGTH(DIC)
QUIT -1
+4 SET DIC(0)=$GET(OCXDIC0)
IF $LENGTH($GET(OCXX))
SET X=OCXX
+5 IF $LENGTH($GET(OCXDICS))
SET DIC("S")=OCXDICS
+6 IF $LENGTH($GET(OCXDICA))
SET DIC("A")=OCXDICA
+7 IF $LENGTH($GET(OCXDR))
SET DIC("DR")=OCXDR
+8 DO ^DIC
IF (Y<1)
QUIT 0
QUIT Y
+9 ;
DIQ(DIC,DA,OCXDIQ0,OCXARY) ;
+1 NEW DR,DIQ
SET DR=".01:99999"
SET DIQ="OCXARY("
SET DIQ(0)=$GET(OCXDIQ0)
+2 DO EN^DIQ1
+3 QUIT
+4 ;
ADDLINK(OCXNAME,OCXSRC) ;
+1 NEW OCXD0,OCXDR
+2 SET OCXD0=+$$DIC("^OCXS(863.2,","XLME","",$PIECE(OCXNAME,".",1))
IF (OCXD0<1)
QUIT 0
+3 SET OCXDR=".02///"_$PIECE(OCXNAME,".",1)_";.04///"_OCXSRC_";.06///99"
+4 SET OCXD0=+$$DIC("^OCXS(863.3,","XLME","",OCXNAME,"",OCXDR)
+5 IF (OCXD0<1)
QUIT 0
QUIT OCXD0
+6 ;
