OCXOED07.m

OCXOED07 ;SLC/RJS,CLA - Rule Editor (Element 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(OCXD0) ;

 ;

 N OCXACT,OCXRD

 F  K OCXRD,OCXACT S (OCXRD,OCXACT)="" D GETDATA(OCXD0,.OCXRD),DISP(OCXD0,.OCXRD,.OCXACT) Q:$$EN^OCXOED08(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)

 ;

 W @IOF,OCXTNLN

 W !,$$CENTER($$FIELD("Element Edit Screen"),80),!!

 W "  ",$$OPT^OCXOEDT("Edit","EDELE","08",.OCXACT,OCXD0)

 W "  ",$$FIELD("Element:")," ",$$DATA($G(OCXRD("ELE",OCXD0,.01,"E")),50)

 W !!,?10,$$FIELD("Context:")," ",$$DATA($G(OCXRD("ELE",OCXD0,.02,"E")),50)

 ;

 W !!,$$SEP("Element Expressions"),!

 S OCXD1=0 F  S OCXD1=$O(OCXRD("ELE",OCXD0,"C",OCXD1)) Q:'OCXD1  D

 .W !

 .W "  ",$$OPT^OCXOEDT("EXP"_OCXD1,"EDEXP","08",.OCXACT,OCXD0_","_OCXD1)

 .W "  ",$$FIELD("Data Field:")," ",$$DATA($G(OCXRD("ELE",OCXD0,"C",OCXD1,1,"E")),50)

 W !

 W !,"  ",$$OPT^OCXOEDT("Add Expression","EOPT","08",.OCXACT,"""ADD"","_OCXD0,"AE")

 W "  ",$$OPT^OCXOEDT("Delete Expression","EOPT","08",.OCXACT,"""DEL"","_OCXD0,"DE")

 ;

 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

 S OCXDIQ="" D DIQ("^OCXS(860.3,",OCXD0,"IEN",.OCXDIQ)

 M OCXD("ELE")=OCXDIQ(860.3) K OCXDIQ S OCXDIQ=""

 S OCXX=0 F  S OCXX=$O(^OCXS(860.3,OCXD0,"COND",OCXX)) Q:'OCXX  W "." D GETMULT(OCXD0,OCXX,"COND","C",860.31,.OCXD)

 Q

 ;

GETMULT(OCXD0,OCXD1,OCXSUB,OCXSLOT,OCXSUBD,OCXD) ;

 ;

 N OCXDIQ

 S OCXDIQ="" D DIQ("^OCXS(860.3,"_OCXD0_","""_OCXSUB_""",",OCXD1,"IEN",.OCXDIQ)

 M OCXD("ELE",OCXD0,OCXSLOT)=OCXDIQ(OCXSUBD) 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

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OCXOED07   2664     printed  Feb 18, 2025@23:51:55                                                                                                                                                                                                    Page 2

OCXOED07  ;SLC/RJS,CLA - Rule Editor (Element 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(OCXD0) ;

 +1       ;

 +2        NEW OCXACT,OCXRD

 +3        FOR 

               KILL OCXRD,OCXACT

               SET (OCXRD,OCXACT)=""

               DO GETDATA(OCXD0,.OCXRD)

               DO DISP(OCXD0,.OCXRD,.OCXACT)

               if $$EN^OCXOED08(OCXD0,.OCXRD,.OCXACT)

                   QUIT 

 +4       ;

 +5        QUIT 

 +6       ;

DISP(OCXD0,OCXRD,OCXACT) ;

 +1       ;

 +2        NEW OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN

 +3       ;

 +4        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)

 +5       ;

 +6        WRITE @IOF,OCXTNLN

 +7        WRITE !,$$CENTER($$FIELD("Element Edit Screen"),80),!!

 +8        WRITE "  ",$$OPT^OCXOEDT("Edit","EDELE","08",.OCXACT,OCXD0)

 +9        WRITE "  ",$$FIELD("Element:")," ",$$DATA($GET(OCXRD("ELE",OCXD0,.01,"E")),50)

 +10       WRITE !!,?10,$$FIELD("Context:")," ",$$DATA($GET(OCXRD("ELE",OCXD0,.02,"E")),50)

 +11      ;

 +12       WRITE !!,$$SEP("Element Expressions"),!

 +13       SET OCXD1=0

           FOR 

               SET OCXD1=$ORDER(OCXRD("ELE",OCXD0,"C",OCXD1))

               if 'OCXD1

                   QUIT 

               Begin DoDot:1

 +14               WRITE !

 +15               WRITE "  ",$$OPT^OCXOEDT("EXP"_OCXD1,"EDEXP","08",.OCXACT,OCXD0_","_OCXD1)

 +16               WRITE "  ",$$FIELD("Data Field:")," ",$$DATA($GET(OCXRD("ELE",OCXD0,"C",OCXD1,1,"E")),50)

               End DoDot:1

 +17       WRITE !

 +18       WRITE !,"  ",$$OPT^OCXOEDT("Add Expression","EOPT","08",.OCXACT,"""ADD"","_OCXD0,"AE")

 +19       WRITE "  ",$$OPT^OCXOEDT("Delete Expression","EOPT","08",.OCXACT,"""DEL"","_OCXD0,"DE")

 +20      ;

 +21       QUIT 

 +22      ;

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

 +3        SET OCXDIQ=""

           DO DIQ("^OCXS(860.3,",OCXD0,"IEN",.OCXDIQ)

 +4        MERGE OCXD("ELE")=OCXDIQ(860.3)

           KILL OCXDIQ

           SET OCXDIQ=""

 +5        SET OCXX=0

           FOR 

               SET OCXX=$ORDER(^OCXS(860.3,OCXD0,"COND",OCXX))

               if 'OCXX

                   QUIT 

               WRITE "."

               DO GETMULT(OCXD0,OCXX,"COND","C",860.31,.OCXD)

 +6        QUIT 

 +7       ;

GETMULT(OCXD0,OCXD1,OCXSUB,OCXSLOT,OCXSUBD,OCXD) ;

 +1       ;

 +2        NEW OCXDIQ

 +3        SET OCXDIQ=""

           DO DIQ("^OCXS(860.3,"_OCXD0_","""_OCXSUB_""",",OCXD1,"IEN",.OCXDIQ)

 +4        MERGE OCXD("ELE",OCXD0,OCXSLOT)=OCXDIQ(OCXSUBD)

           KILL OCXDIQ

           SET OCXDIQ=""

 +5        QUIT 

 +6       ;

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)

           DO EN^DIQ1

 +2        QUIT 

 +3       ;