ORICHECK ; SLC/AGP - Information panel and editor structure checker ;Jan 08, 2026@12:50:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
;
;
;
Q
;
CHECKITEM(RESULTS,INPUTS,PIDX,SIDX,IIDX) ;
N ACT,CDRPC,DCODE,EDITOR,ERROR,FAIL,HASDETAIL,ISREM,LBL,NEEDREQ,NODE,RIDX,TMP
S LBL="Item: #"
S ERROR="Missing or incorrect value for the "
S NODE=$G(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,0))
I NODE="" Q
I $P(NODE,U,3)'="E" Q
S TMP=LBL_IIDX_" "_$P(NODE,U,2)
S HASDETAIL=+$O(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DTXT","A"),-1)
I +$P(NODE,U)<1 D SETERROR(.RESULTS,TMP_ERROR_"SEQUENCE field.") Q
I $P(NODE,U,2)="" D SETERROR(.RESULTS,TMP_ERROR_"NAME field.") Q
I $P(NODE,U,4)="" D SETERROR(.RESULTS,TMP_ERROR_"DISPLAY TEXT field.") Q
I $P(NODE,U,5)="" D SETERROR(.RESULTS,TMP_ERROR_"ABBREVIATION field.") Q
S NODE=$G(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,10))
;check evaluation fields
S FAIL=0,ISREM=0
I $P(NODE,U)="" D SETERROR(.RESULTS,TMP_ERROR_"evaluation type field.") Q
I $P(NODE,U)="RD" D I FAIL=1 Q
.S ISREM=1
.I ($P(NODE,U,2)'["PXD(811.9") D SETERROR(.RESULTS,TMP_ERROR_"REMINDER COMPONENT field.") S FAIL=1 Q
.I "ADN"'[$P(NODE,U,3)!($P(NODE,U,3)="") D SETERROR(.RESULTS,TMP_ERROR_"REMINDER STATUS field.") S FAIL=1
I $P(NODE,U)="RT" D I FAIL=1 Q
.S ISREM=1
.I ($P(NODE,U,2)'["PXRMD(811.5") D SETERROR(.RESULTS,TMP_ERROR_"REMINDER COMPONENT field.") S FAIL=1 Q
.I "TF"'[$P(NODE,U,3)!($P(NODE,U,3)="") D SETERROR(.RESULTS,TMP_ERROR_"REMINDER STATUS field.") S FAIL=1
I $P(NODE,U)="C",+$P(NODE,U,4)=0 D SETERROR(.RESULTS,TMP_ERROR_"EVALUATION CODE field.") Q
;check action fields
S NODE=$G(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,30))
I $P(NODE,U)="" D SETERROR(.RESULTS,TMP_ERROR_"ACTION field.") Q
S ACT=$$GETCOMP^ORDD71($P(NODE,U))
I ACT'["act" D SETERROR(.RESULTS,TMP_ERROR_"ACTION field.") Q
S CDRPC="",DCODE=0,EDITOR=0
I ACT'="actNone",ACT'="actShowMessage" D I FAIL=1 Q
.I $P(NODE,U,2)="" D SETERROR(.RESULTS,TMP_ERROR_"FORM TYPE field.") S FAIL=1 Q
.S CDRPC=$P(NODE,U,4)="true",DCODE=+$P(NODE,U,3),EDITOR=+$P(NODE,U,5)
.I ACT="actShowEditor"!(ACT="actShowHTMLEditor") D Q
..I EDITOR=0 D SETERROR(.RESULTS,TMP_ERROR_"EDITOR field.") S FAIL=1 Q
..I CDRPC=0 D SETERROR(.RESULTS,"CALL DETAIL RPC field should be set to True.") S FAIL=1 Q
..I '$$CHKEDITOR(.RESULTS,EDITOR) S FAIL=1
.I ACT="actShowUrl" D Q
..I $P($G(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"URL")),U)'=""!(DCODE>0) Q
..D SETERROR(.RESULTS,TMP_" is either missing the URL value or the Detail Code value.") S FAIL=1
.;actShowDetail,actShowMessage
.I 'ISREM,'DCODE,'HASDETAIL D SETERROR(.RESULTS,TMP_" Set to show detail text but missing reminders, detail code, or detail text.") S FAIL=1 Q
;
S NEEDREQ=0,RIDX=0,FAIL=0
F S RIDX=$O(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX)) Q:RIDX'>0!(NEEDREQ=1)!(FAIL=1) D
.S NODE=$G(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX,0))
.I +$P(NODE,U)=0 D SETERROR(.RESULTS,TMP_ERROR_"REQUIRED DATA field for index: "_RIDX) S FAIL=1 Q
.I $P(NODE,U,2)="" D SETERROR(.RESULTS,TMP_ERROR_"REQUIRED field for index: "_RIDX) S FAIL=1 Q
.S NEEDREQ=$S($P(NODE,U,2)="Y":1,$P(NODE,U,2)="O":1,1:0)
I NEEDREQ,'CDRPC D SETERROR(.RESULTS,TMP_" CALL DETAIL RPC field should be set to True.") Q
Q
;
CHECKPANEL(RESULTS,INPUTS) ;
N IIDX,ISEQ,PIDX,PKG,SIDX,SSEQ,TMP
S RESULTS("success")="true"
S PIDX=0 F S PIDX=$O(INPUTS("PKG",PIDX)) Q:PIDX'>0!(RESULTS("success")="false") D
.S PKG=$P($G(INPUTS("PKG",PIDX,0)),U),PKG=$$GET1^DIQ(9.4,PKG_",",.01)
.S SSEQ=0 F S SSEQ=$O(INPUTS("PKG",PIDX,"LOC","B",SSEQ)) Q:SSEQ'>0!(RESULTS("success")="false") D
..S SIDX=$O(INPUTS("PKG",PIDX,"LOC","B",SSEQ,"")) Q:SIDX'>0
..D CHECKSECTION(.RESULTS,.INPUTS,PIDX,SIDX) I RESULTS("success")="false" Q
..S ISEQ=0
..F S ISEQ=$O(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ)) Q:ISEQ'>0!(RESULTS("success")="false") D
...S IIDX=$O(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ,"")) Q:IIDX'>0
...D CHECKITEM(.RESULTS,.INPUTS,PIDX,SIDX,IIDX)
Q
;
CHECKSECTION(RESULTS,INPUTS,PIDX,SIDX) ;
N LBL,NAME,NODE,TMP
S NAME="",LBL="Section: #"
S NODE=$G(INPUTS("PKG",PIDX,"LOC",SIDX,0))
I $P(NODE,U,2)>0 S NAME=$P($G(^ORI(101.73,$P(NODE,U,2),0)),U)
S TMP=LBL_SIDX_" "_NAME
I +$P(NODE,U)<1 D SETERROR(.RESULTS,TMP_" Missing or incorrect sequence value.") Q
I +$P(NODE,U,2)<1 D SETERROR(.RESULTS,TMP_" Missing or incorrect location value.") Q
I $P(NODE,U,3)="" D SETERROR(.RESULTS,TMP_" Missing or incorrect display text value.") Q
I $P(NODE,U,4)="" D SETERROR(.RESULTS,TMP_" Missing or incorrect abbreviation value.") Q
Q
;
SETERROR(RESULTS,ERROR) ;
S RESULTS("success")="false"
S RESULTS("error")=$G(RESULTS("error"))_ERROR_$C(13)_$C(10)
Q
;
CHKEDITOR(RESULTS,EID) ;
N CELLNAME,CODE,IDX,NAME,NODE,RESULT,TMP
S NODE=$G(^ORE(101.74,EID,0))
S NAME=$P(NODE,U)
S TMP="Editor: #"_EID_" "_NAME
I NAME="" D SETERROR(.RESULTS,TMP_"Editor does not have name defined.") Q 0
I $P(NODE,U,2) D SETERROR(.RESULTS,"Does not have display name defined.") Q 0
S NODE=$G(^ORE(101.74,EID,40))
I +$P(NODE,U)="" D SETERROR(.RESULTS,"Plugin value not defined") Q 0
Q 1
;
SETTEXT(TXT,TEXT,TCNT) ;
S TCNT=TCNT+1
S TEXT(TCNT)=TXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORICHECK 5303 printed May 25, 2026@12:35:02 Page 2
ORICHECK ; SLC/AGP - Information panel and editor structure checker ;Jan 08, 2026@12:50:15
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
+2 ;
+3 ;
+4 ;
+5 QUIT
+6 ;
CHECKITEM(RESULTS,INPUTS,PIDX,SIDX,IIDX) ;
+1 NEW ACT,CDRPC,DCODE,EDITOR,ERROR,FAIL,HASDETAIL,ISREM,LBL,NEEDREQ,NODE,RIDX,TMP
+2 SET LBL="Item: #"
+3 SET ERROR="Missing or incorrect value for the "
+4 SET NODE=$GET(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,0))
+5 IF NODE=""
QUIT
+6 IF $PIECE(NODE,U,3)'="E"
QUIT
+7 SET TMP=LBL_IIDX_" "_$PIECE(NODE,U,2)
+8 SET HASDETAIL=+$ORDER(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DTXT","A"),-1)
+9 IF +$PIECE(NODE,U)<1
DO SETERROR(.RESULTS,TMP_ERROR_"SEQUENCE field.")
QUIT
+10 IF $PIECE(NODE,U,2)=""
DO SETERROR(.RESULTS,TMP_ERROR_"NAME field.")
QUIT
+11 IF $PIECE(NODE,U,4)=""
DO SETERROR(.RESULTS,TMP_ERROR_"DISPLAY TEXT field.")
QUIT
+12 IF $PIECE(NODE,U,5)=""
DO SETERROR(.RESULTS,TMP_ERROR_"ABBREVIATION field.")
QUIT
+13 SET NODE=$GET(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,10))
+14 ;check evaluation fields
+15 SET FAIL=0
SET ISREM=0
+16 IF $PIECE(NODE,U)=""
DO SETERROR(.RESULTS,TMP_ERROR_"evaluation type field.")
QUIT
+17 IF $PIECE(NODE,U)="RD"
Begin DoDot:1
+18 SET ISREM=1
+19 IF ($PIECE(NODE,U,2)'["PXD(811.9")
DO SETERROR(.RESULTS,TMP_ERROR_"REMINDER COMPONENT field.")
SET FAIL=1
QUIT
+20 IF "ADN"'[$PIECE(NODE,U,3)!($PIECE(NODE,U,3)="")
DO SETERROR(.RESULTS,TMP_ERROR_"REMINDER STATUS field.")
SET FAIL=1
End DoDot:1
IF FAIL=1
QUIT
+21 IF $PIECE(NODE,U)="RT"
Begin DoDot:1
+22 SET ISREM=1
+23 IF ($PIECE(NODE,U,2)'["PXRMD(811.5")
DO SETERROR(.RESULTS,TMP_ERROR_"REMINDER COMPONENT field.")
SET FAIL=1
QUIT
+24 IF "TF"'[$PIECE(NODE,U,3)!($PIECE(NODE,U,3)="")
DO SETERROR(.RESULTS,TMP_ERROR_"REMINDER STATUS field.")
SET FAIL=1
End DoDot:1
IF FAIL=1
QUIT
+25 IF $PIECE(NODE,U)="C"
IF +$PIECE(NODE,U,4)=0
DO SETERROR(.RESULTS,TMP_ERROR_"EVALUATION CODE field.")
QUIT
+26 ;check action fields
+27 SET NODE=$GET(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,30))
+28 IF $PIECE(NODE,U)=""
DO SETERROR(.RESULTS,TMP_ERROR_"ACTION field.")
QUIT
+29 SET ACT=$$GETCOMP^ORDD71($PIECE(NODE,U))
+30 IF ACT'["act"
DO SETERROR(.RESULTS,TMP_ERROR_"ACTION field.")
QUIT
+31 SET CDRPC=""
SET DCODE=0
SET EDITOR=0
+32 IF ACT'="actNone"
IF ACT'="actShowMessage"
Begin DoDot:1
+33 IF $PIECE(NODE,U,2)=""
DO SETERROR(.RESULTS,TMP_ERROR_"FORM TYPE field.")
SET FAIL=1
QUIT
+34 SET CDRPC=$PIECE(NODE,U,4)="true"
SET DCODE=+$PIECE(NODE,U,3)
SET EDITOR=+$PIECE(NODE,U,5)
+35 IF ACT="actShowEditor"!(ACT="actShowHTMLEditor")
Begin DoDot:2
+36 IF EDITOR=0
DO SETERROR(.RESULTS,TMP_ERROR_"EDITOR field.")
SET FAIL=1
QUIT
+37 IF CDRPC=0
DO SETERROR(.RESULTS,"CALL DETAIL RPC field should be set to True.")
SET FAIL=1
QUIT
+38 IF '$$CHKEDITOR(.RESULTS,EDITOR)
SET FAIL=1
End DoDot:2
QUIT
+39 IF ACT="actShowUrl"
Begin DoDot:2
+40 IF $PIECE($GET(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"URL")),U)'=""!(DCODE>0)
QUIT
+41 DO SETERROR(.RESULTS,TMP_" is either missing the URL value or the Detail Code value.")
SET FAIL=1
End DoDot:2
QUIT
+42 ;actShowDetail,actShowMessage
+43 IF 'ISREM
IF 'DCODE
IF 'HASDETAIL
DO SETERROR(.RESULTS,TMP_" Set to show detail text but missing reminders, detail code, or detail text.")
SET FAIL=1
QUIT
End DoDot:1
IF FAIL=1
QUIT
+44 ;
+45 SET NEEDREQ=0
SET RIDX=0
SET FAIL=0
+46 FOR
SET RIDX=$ORDER(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX))
if RIDX'>0!(NEEDREQ=1)!(FAIL=1)
QUIT
Begin DoDot:1
+47 SET NODE=$GET(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX,0))
+48 IF +$PIECE(NODE,U)=0
DO SETERROR(.RESULTS,TMP_ERROR_"REQUIRED DATA field for index: "_RIDX)
SET FAIL=1
QUIT
+49 IF $PIECE(NODE,U,2)=""
DO SETERROR(.RESULTS,TMP_ERROR_"REQUIRED field for index: "_RIDX)
SET FAIL=1
QUIT
+50 SET NEEDREQ=$SELECT($PIECE(NODE,U,2)="Y":1,$PIECE(NODE,U,2)="O":1,1:0)
End DoDot:1
+51 IF NEEDREQ
IF 'CDRPC
DO SETERROR(.RESULTS,TMP_" CALL DETAIL RPC field should be set to True.")
QUIT
+52 QUIT
+53 ;
CHECKPANEL(RESULTS,INPUTS) ;
+1 NEW IIDX,ISEQ,PIDX,PKG,SIDX,SSEQ,TMP
+2 SET RESULTS("success")="true"
+3 SET PIDX=0
FOR
SET PIDX=$ORDER(INPUTS("PKG",PIDX))
if PIDX'>0!(RESULTS("success")="false")
QUIT
Begin DoDot:1
+4 SET PKG=$PIECE($GET(INPUTS("PKG",PIDX,0)),U)
SET PKG=$$GET1^DIQ(9.4,PKG_",",.01)
+5 SET SSEQ=0
FOR
SET SSEQ=$ORDER(INPUTS("PKG",PIDX,"LOC","B",SSEQ))
if SSEQ'>0!(RESULTS("success")="false")
QUIT
Begin DoDot:2
+6 SET SIDX=$ORDER(INPUTS("PKG",PIDX,"LOC","B",SSEQ,""))
if SIDX'>0
QUIT
+7 DO CHECKSECTION(.RESULTS,.INPUTS,PIDX,SIDX)
IF RESULTS("success")="false"
QUIT
+8 SET ISEQ=0
+9 FOR
SET ISEQ=$ORDER(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ))
if ISEQ'>0!(RESULTS("success")="false")
QUIT
Begin DoDot:3
+10 SET IIDX=$ORDER(INPUTS("PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ,""))
if IIDX'>0
QUIT
+11 DO CHECKITEM(.RESULTS,.INPUTS,PIDX,SIDX,IIDX)
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
CHECKSECTION(RESULTS,INPUTS,PIDX,SIDX) ;
+1 NEW LBL,NAME,NODE,TMP
+2 SET NAME=""
SET LBL="Section: #"
+3 SET NODE=$GET(INPUTS("PKG",PIDX,"LOC",SIDX,0))
+4 IF $PIECE(NODE,U,2)>0
SET NAME=$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,2),0)),U)
+5 SET TMP=LBL_SIDX_" "_NAME
+6 IF +$PIECE(NODE,U)<1
DO SETERROR(.RESULTS,TMP_" Missing or incorrect sequence value.")
QUIT
+7 IF +$PIECE(NODE,U,2)<1
DO SETERROR(.RESULTS,TMP_" Missing or incorrect location value.")
QUIT
+8 IF $PIECE(NODE,U,3)=""
DO SETERROR(.RESULTS,TMP_" Missing or incorrect display text value.")
QUIT
+9 IF $PIECE(NODE,U,4)=""
DO SETERROR(.RESULTS,TMP_" Missing or incorrect abbreviation value.")
QUIT
+10 QUIT
+11 ;
SETERROR(RESULTS,ERROR) ;
+1 SET RESULTS("success")="false"
+2 SET RESULTS("error")=$GET(RESULTS("error"))_ERROR_$CHAR(13)_$CHAR(10)
+3 QUIT
+4 ;
CHKEDITOR(RESULTS,EID) ;
+1 NEW CELLNAME,CODE,IDX,NAME,NODE,RESULT,TMP
+2 SET NODE=$GET(^ORE(101.74,EID,0))
+3 SET NAME=$PIECE(NODE,U)
+4 SET TMP="Editor: #"_EID_" "_NAME
+5 IF NAME=""
DO SETERROR(.RESULTS,TMP_"Editor does not have name defined.")
QUIT 0
+6 IF $PIECE(NODE,U,2)
DO SETERROR(.RESULTS,"Does not have display name defined.")
QUIT 0
+7 SET NODE=$GET(^ORE(101.74,EID,40))
+8 IF +$PIECE(NODE,U)=""
DO SETERROR(.RESULTS,"Plugin value not defined")
QUIT 0
+9 QUIT 1
+10 ;
SETTEXT(TXT,TEXT,TCNT) ;
+1 SET TCNT=TCNT+1
+2 SET TEXT(TCNT)=TXT
+3 QUIT
