ORDD71 ; SLC/AGP - Information panel and editor DD entry points ;Mar 17, 2025@19:19:04
;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
;
; Reference to $$ISACTIVE^PXRMAPI supported by DBIA # 7466
;
Q
;========================= internal API ================================
GETACT(DA) ;
N COMPIEN,RESULT
S COMPIEN=$P($G(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30)),U) I COMPIEN=0 Q ""
Q $$GETCOMP(COMPIEN)
;
GETCOMP(IDX) ;
Q $P($G(^ORI(101.73,IDX,0)),U,3)
;
GETETYPE(DA) ;
Q $P($G(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,10)),U)
;
GETRDATA(DA) ;
Q $P($G(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,10)),U,2,3)
;
INUSE(FN,IEN) ;
N ORFILES
D CHKPT^DIUTL(FN,IEN,"ORFILES",1)
Q ORFILES(0)
;
ISLISTCOMP(COMPIEN) ;
N NAME
I COMPIEN="" Q 0
S NAME=$P($G(^ORI(101.73,COMPIEN,0)),U,3)
I NAME="ptCBO" Q 1
I NAME="ptCBOFreeText" Q 1
I NAME="ptCBOLongList" Q 1
I NAME="ptCheckBox" Q 1
I NAME="ptCheckListBox" Q 1
I NAME="ptListBox" Q 1
Q 0
;
ISTYPE(IEN,TYPE) ;
I $P($G(^ORI(101.73,IEN,0)),U,2)=TYPE Q 1
Q 0
;
;========================= end internal API ============================
GETEDITORS(ONEOF,SUB) ;
N CNT,IDX,NAME
S NAME="",CNT=0 F S NAME=$O(^ORE(101.74,"B",NAME)) Q:NAME="" D
.S IDX=0 F S IDX=$O(^ORE(101.74,"B",NAME,IDX)) Q:IDX'>0 D SETONEOF(.ONEOF,SUB,.CNT,IDX,NAME)
Q
;
GETPLUGINS(ONEOF,SUB) ;
N CNT,IDX,NAME
S NAME="",CNT=0 F S NAME=$O(^OR(101.75,"B",NAME)) Q:NAME="" D
.S IDX=0 F S IDX=$O(^OR(101.75,"B",NAME,IDX)) Q:IDX'>0 D SETONEOF(.ONEOF,SUB,.CNT,IDX,NAME)
Q
;
GETLONGLIST(ONEOF,SUB) ;
N CNT,IDX,NAME
S NAME="",CNT=0 F S NAME=$O(^OR(101.75,"B",NAME)) Q:NAME="" D
.S IDX=0 F S IDX=$O(^OR(101.75,"B",NAME,IDX)) Q:IDX'>0 D:$P($G(^OR(101.75,IDX,0)),U,4)="L" SETONEOF(.ONEOF,SUB,.CNT,IDX,NAME)
Q
;
GETSCHEMAS(ONEOF,SUB,TYPE) ;
N ARRAY,CNT,IDX,NAME,SIEN
S CNT=0
I TYPE="" Q
S SIEN=+$O(^ORW(101.77,"B",TYPE,"")) I SIEN=0 Q
S IDX=0 F S IDX=$O(^ORW(101.76,"C",SIEN,IDX)) Q:IDX'>0 D
.S ARRAY($P($G(^ORW(101.76,IDX,0)),U))=IDX
S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D SETONEOF(.ONEOF,SUB,.CNT,ARRAY(NAME),NAME)
Q
;
SETONEOF(ONEOF,SUB,CNT,CONST,TITLE) ;
S CNT=CNT+1
S ONEOF(SUB,CNT,"const")=CONST
S ONEOF(SUB,CNT,"title")=TITLE
Q
;
FINDNATPANE() ;
N NODE,PANE,RESULT
S RESULT=0
S PANE=0 F S PANE=$O(^ORI(101.71,"TAB","A",PANE)) Q:PANE'>0!(RESULT>0) D
.I $P($G(^ORI(101.71,PANE,0)),U,4)="" S RESULT=PANE
Q RESULT
;
SETIMAGEICON(DA) ;
I $P($G(^ORI(101.73,DA,0)),U)="" Q
I $P($G(^ORI(101.73,DA,0)),U,2)'="I" Q
I $P(^ORI(101.73,DA,0),U,3)'="" Q
S $P(^ORI(101.73,DA,0),U,3)="imgIcon"
Q
;
;
SETONCLICK(DA) ;
N DCODE,EDITOR,IEN,IDX,NODE,RESULT
S NODE=$G(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30))
S DCODE=+$P(NODE,U,3)
S EDITOR=+$P(NODE,U,5)
S RESULT=$S(EDITOR>0:1,DCODE>0:1,1:0)
I RESULT=0 D
.S IDX=0
.F S IDX=$O(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,"REQD",IDX)) Q:IDX'>0!(RESULT=1) D
..I $P($G(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,"REQD",IDX,0)),U,2)'="N" S RESULT=1
I RESULT=1,$P(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30),U,4)="" D
.S $P(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30),U,4)=1
Q
;
VCOMBO(DA) ;
N COMPIEN
S COMPIEN=$P($G(^ORE(101.74,DA(1),30,DA,0)),U,2)
I COMPIEN=0 Q 0
Q $$ISLISTCOMP(COMPIEN)
;
VDCODE(DA) ;
N GUIC,ACT,ETYPE
S ETYPE=$$GETETYPE(.DA)
S ACT=$$GETACT(.DA)
S ACT=$E(ETYPE,1,3)'="act" Q 0
I ACT="actNone" Q 0
I ACT="actShowEditor" Q 0
Q 1
;
VECODE(DA,VALUE) ;
Q $$GETETYPE(.DA)=VALUE
;
VEDITOR(DA,VALUE) ;
N ACT
S ACT=$P($G(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30)),U)
I '$$VCOMPONENT(ACT,"A") Q 0
I $P($G(^ORI(101.73,ACT,0)),U,3)'="actShowEditor" Q 0
I $P($G(^ORE(101.74,VALUE,0)),U,3)=1 Q 0
Q 1
;
VCOMPONENT(IEN,VALUE) ;
N TYPE
S TYPE=$P($G(^ORI(101.73,IEN,0)),U,3)
I VALUE="A",$E(TYPE,1,3)'="act" Q 0
I VALUE="C",$E(TYPE,1,2)'="cl" Q 0
I VALUE="D",$E(TYPE,1,4)'="data" Q 0
I VALUE="I",$E(TYPE,1,3)'="img" Q 0
I VALUE="L",$E(TYPE,1,3)'="tab" Q 0
I VALUE="P",$E(TYPE,1,2)'="pt" Q 0
Q 1
;
VGUICNAME(IEN,VALUE) ;
N TYPE
S TYPE=$P($G(^ORI(101.73,IEN,0)),U,2)
I TYPE="A",$E(VALUE,1,3)'="act" Q 0
I TYPE="D",$E(VALUE,1,4)'="data" Q 0
I TYPE="P",$E(VALUE,1,2)'="pt" Q 0
Q 1
;
VLONGLIST(DA,VALUE) ;
Q 1
N COMPIEN,NAME
S COMPIEN=$P($G(^ORE(101.74,DA(1),30,DA,0)),U,2)
I COMPIEN=0 Q 0
I $P($G(^ORI(101.73,COMPIEN,0)),U,3)'="ptListBox" Q 0
I $P($G(^OR(101.75,VALUE,0)),U,4)'="L" Q 0
Q 1
;
VLONGP(DA,VALUE) ;
I +$P($G(^ORE(101.74,DA(1),30,DA,30)),U,3)=0 Q 0
Q 1
;
VREM(Y,FN) ;
N RESULT
S RESULT=0
I FN=811.9 D
.I '$D(^PXD(811.9,"I",+Y)) Q
.I $$ISACTIVE^PXRMAPI(FN,+Y) S RESULT=1
I FN=811.5 D
.I $D(^PXRMD(811.5,"I",+Y)) S RESULT=1
Q RESULT
;
VREMSTAT(DA,Y) ;
I +$G(PXRMEXCH)=1 Q 1
N ISTERM,REMCOMP
S REMCOMP=$P($$GETRDATA(.DA),U) I REMCOMP="" Q 0
S ISTERM=$S(REMCOMP["PXRMD(811.5":1,1:0)
I ISTERM=1&(Y="F"!(Y="T"))!(Y="TRUE")!(Y="FALSE") Q 1
I ISTERM=0&(Y="D"!(Y="A")!(Y="N"))!(Y="DUE")!(Y="APPLICABLE")!(Y="N/A") Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDD71 5216 printed May 25, 2026@12:33:47 Page 2
ORDD71 ; SLC/AGP - Information panel and editor DD entry points ;Mar 17, 2025@19:19:04
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
+2 ;
+3 ; Reference to $$ISACTIVE^PXRMAPI supported by DBIA # 7466
+4 ;
+5 QUIT
+6 ;========================= internal API ================================
GETACT(DA) ;
+1 NEW COMPIEN,RESULT
+2 SET COMPIEN=$PIECE($GET(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30)),U)
IF COMPIEN=0
QUIT ""
+3 QUIT $$GETCOMP(COMPIEN)
+4 ;
GETCOMP(IDX) ;
+1 QUIT $PIECE($GET(^ORI(101.73,IDX,0)),U,3)
+2 ;
GETETYPE(DA) ;
+1 QUIT $PIECE($GET(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,10)),U)
+2 ;
GETRDATA(DA) ;
+1 QUIT $PIECE($GET(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,10)),U,2,3)
+2 ;
INUSE(FN,IEN) ;
+1 NEW ORFILES
+2 DO CHKPT^DIUTL(FN,IEN,"ORFILES",1)
+3 QUIT ORFILES(0)
+4 ;
ISLISTCOMP(COMPIEN) ;
+1 NEW NAME
+2 IF COMPIEN=""
QUIT 0
+3 SET NAME=$PIECE($GET(^ORI(101.73,COMPIEN,0)),U,3)
+4 IF NAME="ptCBO"
QUIT 1
+5 IF NAME="ptCBOFreeText"
QUIT 1
+6 IF NAME="ptCBOLongList"
QUIT 1
+7 IF NAME="ptCheckBox"
QUIT 1
+8 IF NAME="ptCheckListBox"
QUIT 1
+9 IF NAME="ptListBox"
QUIT 1
+10 QUIT 0
+11 ;
ISTYPE(IEN,TYPE) ;
+1 IF $PIECE($GET(^ORI(101.73,IEN,0)),U,2)=TYPE
QUIT 1
+2 QUIT 0
+3 ;
+4 ;========================= end internal API ============================
GETEDITORS(ONEOF,SUB) ;
+1 NEW CNT,IDX,NAME
+2 SET NAME=""
SET CNT=0
FOR
SET NAME=$ORDER(^ORE(101.74,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+3 SET IDX=0
FOR
SET IDX=$ORDER(^ORE(101.74,"B",NAME,IDX))
if IDX'>0
QUIT
DO SETONEOF(.ONEOF,SUB,.CNT,IDX,NAME)
End DoDot:1
+4 QUIT
+5 ;
GETPLUGINS(ONEOF,SUB) ;
+1 NEW CNT,IDX,NAME
+2 SET NAME=""
SET CNT=0
FOR
SET NAME=$ORDER(^OR(101.75,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+3 SET IDX=0
FOR
SET IDX=$ORDER(^OR(101.75,"B",NAME,IDX))
if IDX'>0
QUIT
DO SETONEOF(.ONEOF,SUB,.CNT,IDX,NAME)
End DoDot:1
+4 QUIT
+5 ;
GETLONGLIST(ONEOF,SUB) ;
+1 NEW CNT,IDX,NAME
+2 SET NAME=""
SET CNT=0
FOR
SET NAME=$ORDER(^OR(101.75,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+3 SET IDX=0
FOR
SET IDX=$ORDER(^OR(101.75,"B",NAME,IDX))
if IDX'>0
QUIT
if $PIECE($GET(^OR(101.75,IDX,0)),U,4)="L"
DO SETONEOF(.ONEOF,SUB,.CNT,IDX,NAME)
End DoDot:1
+4 QUIT
+5 ;
GETSCHEMAS(ONEOF,SUB,TYPE) ;
+1 NEW ARRAY,CNT,IDX,NAME,SIEN
+2 SET CNT=0
+3 IF TYPE=""
QUIT
+4 SET SIEN=+$ORDER(^ORW(101.77,"B",TYPE,""))
IF SIEN=0
QUIT
+5 SET IDX=0
FOR
SET IDX=$ORDER(^ORW(101.76,"C",SIEN,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+6 SET ARRAY($PIECE($GET(^ORW(101.76,IDX,0)),U))=IDX
End DoDot:1
+7 SET NAME=""
FOR
SET NAME=$ORDER(ARRAY(NAME))
if NAME=""
QUIT
DO SETONEOF(.ONEOF,SUB,.CNT,ARRAY(NAME),NAME)
+8 QUIT
+9 ;
SETONEOF(ONEOF,SUB,CNT,CONST,TITLE) ;
+1 SET CNT=CNT+1
+2 SET ONEOF(SUB,CNT,"const")=CONST
+3 SET ONEOF(SUB,CNT,"title")=TITLE
+4 QUIT
+5 ;
FINDNATPANE() ;
+1 NEW NODE,PANE,RESULT
+2 SET RESULT=0
+3 SET PANE=0
FOR
SET PANE=$ORDER(^ORI(101.71,"TAB","A",PANE))
if PANE'>0!(RESULT>0)
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^ORI(101.71,PANE,0)),U,4)=""
SET RESULT=PANE
End DoDot:1
+5 QUIT RESULT
+6 ;
SETIMAGEICON(DA) ;
+1 IF $PIECE($GET(^ORI(101.73,DA,0)),U)=""
QUIT
+2 IF $PIECE($GET(^ORI(101.73,DA,0)),U,2)'="I"
QUIT
+3 IF $PIECE(^ORI(101.73,DA,0),U,3)'=""
QUIT
+4 SET $PIECE(^ORI(101.73,DA,0),U,3)="imgIcon"
+5 QUIT
+6 ;
+7 ;
SETONCLICK(DA) ;
+1 NEW DCODE,EDITOR,IEN,IDX,NODE,RESULT
+2 SET NODE=$GET(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30))
+3 SET DCODE=+$PIECE(NODE,U,3)
+4 SET EDITOR=+$PIECE(NODE,U,5)
+5 SET RESULT=$SELECT(EDITOR>0:1,DCODE>0:1,1:0)
+6 IF RESULT=0
Begin DoDot:1
+7 SET IDX=0
+8 FOR
SET IDX=$ORDER(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,"REQD",IDX))
if IDX'>0!(RESULT=1)
QUIT
Begin DoDot:2
+9 IF $PIECE($GET(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,"REQD",IDX,0)),U,2)'="N"
SET RESULT=1
End DoDot:2
End DoDot:1
+10 IF RESULT=1
IF $PIECE(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30),U,4)=""
Begin DoDot:1
+11 SET $PIECE(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30),U,4)=1
End DoDot:1
+12 QUIT
+13 ;
VCOMBO(DA) ;
+1 NEW COMPIEN
+2 SET COMPIEN=$PIECE($GET(^ORE(101.74,DA(1),30,DA,0)),U,2)
+3 IF COMPIEN=0
QUIT 0
+4 QUIT $$ISLISTCOMP(COMPIEN)
+5 ;
VDCODE(DA) ;
+1 NEW GUIC,ACT,ETYPE
+2 SET ETYPE=$$GETETYPE(.DA)
+3 SET ACT=$$GETACT(.DA)
+4 SET ACT=$EXTRACT(ETYPE,1,3)'="act"
QUIT 0
+5 IF ACT="actNone"
QUIT 0
+6 IF ACT="actShowEditor"
QUIT 0
+7 QUIT 1
+8 ;
VECODE(DA,VALUE) ;
+1 QUIT $$GETETYPE(.DA)=VALUE
+2 ;
VEDITOR(DA,VALUE) ;
+1 NEW ACT
+2 SET ACT=$PIECE($GET(^ORI(101.71,DA(3),"PKG",DA(2),"LOC",DA(1),"ITM",DA,30)),U)
+3 IF '$$VCOMPONENT(ACT,"A")
QUIT 0
+4 IF $PIECE($GET(^ORI(101.73,ACT,0)),U,3)'="actShowEditor"
QUIT 0
+5 IF $PIECE($GET(^ORE(101.74,VALUE,0)),U,3)=1
QUIT 0
+6 QUIT 1
+7 ;
VCOMPONENT(IEN,VALUE) ;
+1 NEW TYPE
+2 SET TYPE=$PIECE($GET(^ORI(101.73,IEN,0)),U,3)
+3 IF VALUE="A"
IF $EXTRACT(TYPE,1,3)'="act"
QUIT 0
+4 IF VALUE="C"
IF $EXTRACT(TYPE,1,2)'="cl"
QUIT 0
+5 IF VALUE="D"
IF $EXTRACT(TYPE,1,4)'="data"
QUIT 0
+6 IF VALUE="I"
IF $EXTRACT(TYPE,1,3)'="img"
QUIT 0
+7 IF VALUE="L"
IF $EXTRACT(TYPE,1,3)'="tab"
QUIT 0
+8 IF VALUE="P"
IF $EXTRACT(TYPE,1,2)'="pt"
QUIT 0
+9 QUIT 1
+10 ;
VGUICNAME(IEN,VALUE) ;
+1 NEW TYPE
+2 SET TYPE=$PIECE($GET(^ORI(101.73,IEN,0)),U,2)
+3 IF TYPE="A"
IF $EXTRACT(VALUE,1,3)'="act"
QUIT 0
+4 IF TYPE="D"
IF $EXTRACT(VALUE,1,4)'="data"
QUIT 0
+5 IF TYPE="P"
IF $EXTRACT(VALUE,1,2)'="pt"
QUIT 0
+6 QUIT 1
+7 ;
VLONGLIST(DA,VALUE) ;
+1 QUIT 1
+2 NEW COMPIEN,NAME
+3 SET COMPIEN=$PIECE($GET(^ORE(101.74,DA(1),30,DA,0)),U,2)
+4 IF COMPIEN=0
QUIT 0
+5 IF $PIECE($GET(^ORI(101.73,COMPIEN,0)),U,3)'="ptListBox"
QUIT 0
+6 IF $PIECE($GET(^OR(101.75,VALUE,0)),U,4)'="L"
QUIT 0
+7 QUIT 1
+8 ;
VLONGP(DA,VALUE) ;
+1 IF +$PIECE($GET(^ORE(101.74,DA(1),30,DA,30)),U,3)=0
QUIT 0
+2 QUIT 1
+3 ;
VREM(Y,FN) ;
+1 NEW RESULT
+2 SET RESULT=0
+3 IF FN=811.9
Begin DoDot:1
+4 IF '$DATA(^PXD(811.9,"I",+Y))
QUIT
+5 IF $$ISACTIVE^PXRMAPI(FN,+Y)
SET RESULT=1
End DoDot:1
+6 IF FN=811.5
Begin DoDot:1
+7 IF $DATA(^PXRMD(811.5,"I",+Y))
SET RESULT=1
End DoDot:1
+8 QUIT RESULT
+9 ;
VREMSTAT(DA,Y) ;
+1 IF +$GET(PXRMEXCH)=1
QUIT 1
+2 NEW ISTERM,REMCOMP
+3 SET REMCOMP=$PIECE($$GETRDATA(.DA),U)
IF REMCOMP=""
QUIT 0
+4 SET ISTERM=$SELECT(REMCOMP["PXRMD(811.5":1,1:0)
+5 IF ISTERM=1&(Y="F"!(Y="T"))!(Y="TRUE")!(Y="FALSE")
QUIT 1
+6 IF ISTERM=0&(Y="D"!(Y="A")!(Y="N"))!(Y="DUE")!(Y="APPLICABLE")!(Y="N/A")
QUIT 1
+7 QUIT 0
+8 ;
