OREDITOR2 ; SLC/AGP - Info Panel Editor Code ;Dec 18, 2025@09:24:32
;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
;
;
Q
;
BLDDA(TIENS,DA) ;
N CNT,IDX
S IDX=$O(TIENS("A"),-1) S DA=TIENS(IDX)
S CNT=0 F S IDX=$O(TIENS(IDX),-1) Q:IDX<1 D
.S DA($I(CNT))=TIENS(IDX)
Q
;
BLDIENS(TIENS) ;
N DA,RESULT
D BLDDA(.TIENS,.DA)
S RESULT=$$IENS^DILF(.DA)
Q RESULT
;
GETIENS(RESULT,IENS) ;
N X
S RESULT="" F X=1:1:$L(IENS)-1 S RESULT(X)=$P(IENS,",",X)
Q
;
DELETE(IARRAY) ;
N ERROR,FDA,IENS,TIENS
S TIENS(1)=1,TIENS(2)=0
F S TIENS(2)=$O(^ORI(101.71,TIENS(1),"PKG",TIENS(2))) Q:TIENS(2)'>0 D
. K TIENS(3),TIENS(4),TIENS(5) S IENS=$$BLDIENS(.TIENS) I '$D(IARRAY(IENS)) S FDA(101.711,IENS,.01)="@" Q
. S TIENS(3)=0
. F S TIENS(3)=$O(^ORI(101.71,TIENS(1),"PKG",TIENS(2),"LOC",TIENS(3))) Q:TIENS(3)'>0 D
..K TIENS(4),TIENS(5) S IENS=$$BLDIENS(.TIENS) I '$D(IARRAY(IENS)) S FDA(101.7112,IENS,.01)="@" Q
..S TIENS(4)=0
..F S TIENS(4)=$O(^ORI(101.71,TIENS(1),"PKG",TIENS(2),"LOC",TIENS(3),"ITM",TIENS(4))) Q:TIENS(4)'>0 D
...K TIENS(5) S IENS=$$BLDIENS(.TIENS) I '$D(IARRAY(IENS)) S FDA(101.71123,IENS,.01)="@" Q
...S TIENS(5)=0
...F S TIENS(5)=$O(^ORI(101.71,TIENS(1),"PKG",TIENS(2),"LOC",TIENS(3),"ITM",TIENS(4),"REQD",TIENS(5))) Q:TIENS(5)'>0 D
....S IENS=$$BLDIENS(.TIENS) I '$D(IARRAY(IENS)) S FDA(101.714,IENS,.01)="@" Q
I '$D(FDA) Q ""
D UPDATE^DIE("","FDA","","ERROR")
Q $S($D(ERROR):"Error",1:"")
;
DIFF(HARRAY,IENS,OBJ) ;
I HARRAY(IENS)'=$$GENAREF^XLFSHAN(160,"OBJ",1) Q 1
Q 0
;
DIFFLOC(OBJ,FDA,TIENS,HARRAY,IARRAY,TEMPSUB) ;
N IDX,IENS,TOBJ
K TIENS(3),TIENS(4),TIENS(5)
I $G(OBJ("locationId"))="" D SETNEWLOC(.OBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB) Q
;S TIENS(3)=OBJ("id"),IENS=$$BLDIENS(.TIENS)
S IENS=OBJ("locationId"),IARRAY(IENS)="",TIENS(3)=$P(IENS,",")
M TOBJ=OBJ K TOBJ("Panels") I $$DIFF(.HARRAY,IENS,.TOBJ) D FDALOC(.OBJ,.FDA,IENS)
S IDX=0 F S IDX=$O(OBJ("Panels",IDX)) Q:IDX'>0 D
.K TOBJ M TOBJ=OBJ("Panels",IDX,"panelObject")
.D DIFFITEM(.TOBJ,.FDA,.TIENS,.HARRAY,.IARRAY,.TEMPSUB)
Q
;
DIFFITEM(OBJ,FDA,TIENS,HARRAY,IARRAY,TEMPSUB) ;
N HRDATA,IDX,IENS,RDATA,TOBJ
K TIENS(4),TIENS(5)
I $G(OBJ("panelId"))="" D SETNEWITEM(.OBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB) Q
S IENS=OBJ("panelId"),IARRAY(IENS)="",TIENS(4)=$P(IENS,",")
M RDATA=OBJ("actionObject","requiredData")
S HRDATA=$$HREQDATA(.RDATA)
M TOBJ=OBJ K TOBJ("actionObject","requiredData")
I $$DIFF(.HARRAY,IENS,.TOBJ) D FDAITEM(.OBJ,.FDA,IENS,.TEMPSUB,HRDATA)
S IDX=0 F S IDX=$O(OBJ("actionObject","requiredData",IDX)) Q:IDX'>0 D
.K TOBJ M TOBJ=OBJ("actionObject","requiredData",IDX)
.D DIFFREQ(.TOBJ,.FDA,.TIENS,.HARRAY,.IARRAY)
Q
;
DIFFREQ(OBJ,FDA,TIENS,HARRAY,IARRAY) ;
N IENS
K TIENS(5)
I $G(OBJ("dataId"))="" D SETNEWDATA(.OBJ,.FDA,.TIENS,.IARRAY) Q
;S TIENS(5)=OBJ("id"),IENS=$$BLDIENS(.TIENS),IARRAY(IENS)=""
S IENS=OBJ("dataId"),IARRAY(IENS)=""
I $$DIFF(.HARRAY,IENS,.OBJ) D FDAREQ(.OBJ,.FDA,IENS)
Q
;
HREQDATA(ARRAY) ;
N IDX,RESULT
S IDX=0,RESULT=0
F S IDX=$O(ARRAY(IDX)) Q:IDX'>0!(RESULT=1) D
.I $G(ARRAY("requiredForAction"))="true" S RESULT=1
Q RESULT
;
FDAITEM(OBJ,FDA,IENS,TEMPSUB,RDATA) ;
N CALLRPC,IDX,TMP,TOBJ,TEXT,TSUB
S TMP=""
I +$G(OBJ("panelSequence"))=0 S FDA(101.71123,IENS,.01)="@" Q
S CALLRPC=$S($G(OBJ("actionObject","callRPC"))'="":OBJ("actionObject","callRPC"),1:"false")
S FDA(101.71123,IENS,.01)=OBJ("panelSequence")
I $G(OBJ("panelName"))'="" S FDA(101.71123,IENS,.02)=$S($G(OBJ("panelName"))'="":OBJ("panelName"),1:"@")
S FDA(101.71123,IENS,.03)=$S($G(OBJ("status"))'="":OBJ("status"),1:"@")
S FDA(101.71123,IENS,.04)=$S($G(OBJ("panelAbbreviation"))'="":OBJ("panelAbbreviation"),1:"@")
S FDA(101.71123,IENS,.05)=$S($G(OBJ("defaultText"))'="":OBJ("defaultText"),1:"@")
S FDA(101.71123,IENS,.06)=$S(+$G(OBJ("backgroundColor","const"))>0:OBJ("backgroundColor","const"),1:"@")
S FDA(101.71123,IENS,.08)=$S(+$G(OBJ("imageIcon","const"))>0:OBJ("imageIcon","const"),1:"@")
S FDA(101.71123,IENS,10)=$S($G(OBJ("evaluationObject","evaluationType"))'="":OBJ("evaluationObject","evaluationType"),1:"@")
S FDA(101.71123,IENS,11)=$S($G(OBJ("evaluationObject","reminderComponent"))'="":OBJ("evaluationObject","reminderComponent"),1:"@")
S FDA(101.71123,IENS,12)=$S($G(OBJ("evaluationObject","reminderStatus"))'="":OBJ("evaluationObject","reminderStatus"),1:"@")
S FDA(101.71123,IENS,13)=$S(+$G(OBJ("evaluationObject","evaluationCode"))>0:OBJ("evaluationObject","evaluationCode"),1:"@")
S FDA(101.71123,IENS,20)=$S($G(OBJ("applicableObject","displayIfApplicable"))="true":1,1:0)
S FDA(101.71123,IENS,21)=$S($G(OBJ("applicableObject","notApplicableabbreviation"))'="":OBJ("applicableObject","notApplicableabbreviation"),1:"@")
S FDA(101.71123,IENS,22)=$S($G(OBJ("applicableObject","notApplicableText"))'="":OBJ("applicableObject","notApplicableText"),1:"@")
S FDA(101.71123,IENS,23)=$S(+$G(OBJ("applicableObject","backgroundColor","const"))>0:OBJ("applicableObject","backgroundColor","const"),1:"@")
S FDA(101.71123,IENS,24)=$S(+$G(OBJ("applicableObject","imageIcon","const"))>0:OBJ("applicableObject","imageIcon","const"),1:"@")
S FDA(101.71123,IENS,30)=$S(+$G(OBJ("actionObject","panelAction","const"))>0:OBJ("actionObject","panelAction","const"),1:"@")
S FDA(101.71123,IENS,31)=$S($G(OBJ("actionObject","formType"))'="":OBJ("actionObject","formType"),1:"@")
S FDA(101.71123,IENS,32)=$S(+$G(OBJ("actionObject","detailCode"))>0:OBJ("actionObject","detailCode"),1:"@")
S FDA(101.71123,IENS,34)=$S(+$G(OBJ("actionObject","editor","const"))>0:OBJ("actionObject","editor","const"),1:"@")
I +$G(FDA(101.71123,IENS,34))>0 S CALLRPC="true"
S FDA(101.71123,IENS,70)=$S($G(OBJ("actionObject","url"))'="":OBJ("actionObject","url"),1:"@")
I $G(OBJ("actionObject","detailText"))="" S FDA(101.71123,IENS,50)="@"
I $G(OBJ("description"))="" S FDA(101.71123,IENS,40)="@"
I $G(OBJ("actionObject","detailText"))'="" D
.K TEXT,TMP M TMP=OBJ("actionObject","detailText")
.D PARSETEXT^OREDITOR1(.TEXT,.TMP)
.S TSUB="IPANEL DETAIL "_IENS
.M ^TMP(TSUB,$J)=TEXT
.S FDA(101.71123,IENS,50)=$NA(^TMP(TSUB,$J)),TEMPSUB(TSUB)=""
I $G(OBJ("description"))'="" D
.K TEXT,TMP M TMP=OBJ("description")
.D PARSETEXT^OREDITOR1(.TEXT,.TMP)
.S TSUB="IPANEL DESCRIPTION "_IENS
.M ^TMP(TSUB,$J)=TEXT S FDA(101.71123,IENS,40)=$NA(^TMP(TSUB,$J)),TEMPSUB(TSUB)=""
I +$G(OBJ("actionObject","editor"))>0 S CALLRPC="true"
I +$G(OBJ("actionObject","detailCode"))>0 S CALLRPC="true"
I RDATA=1 S CALLRPC="true"
S FDA(101.71123,IENS,33)=CALLRPC
Q
;
FDALOC(OBJ,FDA,IENS) ;
N TMP
I +$G(OBJ("locationSequence"))=0 S FDA(101.7112,IENS,.01)="@" Q
S FDA(101.7112,IENS,.01)=OBJ("locationSequence")
S FDA(101.7112,IENS,.02)=$S(+$G(OBJ("location","const"))>0:OBJ("location","const"),1:"@")
S FDA(101.7112,IENS,.03)=$S($G(OBJ("displayText"))'="":OBJ("displayText"),1:"@")
S FDA(101.7112,IENS,.04)=$S($G(OBJ("abbreviation"))'="":OBJ("abbreviation"),1:"@")
S FDA(101.7112,IENS,.05)=$S(+$G(OBJ("backgroundColor","const"))>0:OBJ("backgroundColor","const"),1:"@")
S FDA(101.7112,IENS,.06)=$S($G(OBJ("disabled"))'="":OBJ("disabled"),1:"@")
S FDA(101.7112,IENS,.07)=$S($G(OBJ("collapsible"))'="":OBJ("collapsible"),1:"@")
S FDA(101.7112,IENS,.08)=$S(+$G(OBJ("imageIcon","const"))>0:OBJ("imageIcon","const"),1:"@")
Q
;
FDAPKG(OBJ,FDA,IENS) ;
I $G(OBJ("package","title"))="" S FDA(101.711,IENS,.01)="@" Q
S FDA(101.711,IENS,.01)=OBJ("package","const")
Q
;
FDAREQ(OBJ,FDA,IENS) ;
I +$G(OBJ("dataType","const"))=0 S FDA(101.714,IENS,.01)="@" Q
S FDA(101.714,IENS,.01)=OBJ("dataType","const")
I $G(OBJ("requiredForAction"))'="" S FDA(101.714,IENS,.02)=$S(OBJ("requiredForAction")="true":1,1:0)
Q
;
IPANEL(INPUTS) ;
I INPUTS("callFrom")="editorSave" Q $$SAVE(.INPUTS)
I INPUTS("callFrom")="editorBuilder" Q $$BLD^OREDITOR4(.INPUTS)
Q "0^Call from entry point not found."
;
SAVE(INPUTS) ;
N DATA,FDA,ERROR,HARRAY,IARRAY,ID,IDX,LIDX,NIDX
N OBJ,ORIMGR,PIDX,RIDX,SHARRAY,SUB,TIENS,TEMPSUB,TMPSUB,TSUB
M DATA=INPUTS("data")
S SUB=INPUTS("subscript")
S NIDX=$$GETNATIONAL^ORIUTL I NIDX=0 Q -1_U_"Could not find the National IDX"
M HARRAY=DATA("hashValues") K DATA("hashValues")
I HARRAY("totalHash")=$$GENAREF^XLFSHAN(512,"DATA",1) Q 1
S FDA(101.71,NIDX_",",.01)="NATIONAL"
S FDA(101.71,NIDX_",",.02)=$S(DATA("active")="true":1,1:0)
S FDA(101.71,NIDX_",",.03)=$$NOW^XLFDT()
;S FDA(101.71,NIDX_",",.04)="CPRS Info Panel Update"
D SETHASHARRAY^OREDITOR1(.HARRAY,.SHARRAY)
S PIDX=0
F S PIDX=$O(DATA("ResponsiblePackages",PIDX)) Q:PIDX'>0 D
. K TIENS S TIENS(1)=NIDX,IDX=0
. S ID=$G(DATA("ResponsiblePackages",PIDX,"packageId")) I ID'="" S IDX=$P(ID,",")
. I ID=""!(IDX=0) M OBJ=DATA("ResponsiblePackages",PIDX) D SETNEWPKG(.OBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB) Q
. S TIENS(2)=IDX,LIDX=0,IARRAY(ID)=""
. F S LIDX=$O(DATA("ResponsiblePackages",PIDX,"locationId",LIDX)) Q:LIDX'>0 D
.. K OBJ M OBJ=DATA("ResponsiblePackages",PIDX,"locationId",LIDX)
.. D DIFFLOC(.OBJ,.FDA,.TIENS,.SHARRAY,.IARRAY,.TEMPSUB)
S ORIMGR=1
I $D(FDA) D FILE^DIE("","FDA","ERROR")
I +$G(ERROR)>0 Q -1_U_"Error performing final update"
I $$DELETE(.IARRAY)'="" Q -1_U_"Error removing records"
S TSUB="" F S TSUB=$O(TEMPSUB(TSUB)) Q:TSUB="" K ^TMP($J,TSUB)
K OBJ,TMPSUB M TMPSUB=^ORI(101.71,NIDX)
D CHECKPANEL^ORICHECK(.OBJ,.TMPSUB) I $G(OBJ("success"))'="true" Q -1_U_"Failed final check after update. "_$C(13)_$C(10)_$G(OBJ("error"))
Q 1
;
SETNEW(TYPE,TIENS,OBJ) ;
N CNT,DA,DIC,IDX,ORIMGR,TMP,X,Y
S DIC(0)="F"
S CNT=0,IDX="A" F S IDX=$O(TIENS(IDX),-1) Q:IDX<1 D
.S DA($I(CNT))=TIENS(IDX)
I TYPE="PKG" D
. S DIC="^ORI(101.71,"_DA(1)_",""PKG"","
. S X=$G(OBJ("package","const"))
I TYPE="LOC" D
. S DIC="^ORI(101.71,"_DA(2)_",""PKG"","_DA(1)_",""LOC"","
. S TMP=OBJ("location","title")
. S X=$G(OBJ("locationSequence")),DIC("DR")=".02///^S X=TMP"
I TYPE="ITM" D
. S DIC="^ORI(101.71,"_DA(3)_",""PKG"","_DA(2)_",""LOC"","_DA(1)_",""ITM"","
. S X=$G(OBJ("panelSequence"))
I TYPE="REQD" D
. S DIC="^ORI(101.71,"_DA(4)_",""PKG"","_DA(3)_",""LOC"","_DA(2)_",""ITM"","_DA(1)_",""REQD"","
. S TMP=$S(OBJ("requiredForAction")="true":1,1:0)
. S X=$G(OBJ("dataType","const")),DIC("DR")=".02///^S X=TMP"
I +$G(X)=0 Q 0
S ORIMGR=1
D FILE^DICN
Q +$G(Y)
;
SETNEWITEM(OBJ,FDA,TIENS,IARRAY,TEMPSUB) ;
N DA,DIC,HRDATA,IDX,IEN,IENS,RDATA,RIDX,TOBJ,Y
K TIENS(4),TIENS(5)
S IEN=$$SETNEW("ITM",.TIENS,.OBJ) I IEN'>0 Q
S TIENS(4)=IEN,IENS=$$BLDIENS(.TIENS),IARRAY(IENS)=""
M RDATA=OBJ("actionObject","requiredData")
S HRDATA=$$HREQDATA(.RDATA)
K TIENS(5) D FDAITEM(.OBJ,.FDA,.IENS,.TEMPSUB,HRDATA)
S IDX=0 F S IDX=$O(OBJ("actionObject","requiredData",IDX)) Q:IDX'>0 D
.K TOBJ M TOBJ=OBJ("actionObject","requiredData",IDX)
.D SETNEWDATA(.TOBJ,.FDA,.TIENS,.IARRAY)
Q
;
SETNEWLOC(OBJ,FDA,TIENS,IARRAY,TEMPSUB) ;
N DA,DIC,IDX,IEN,IENS,TOBJ,Y
K TIENS(3),TIENS(4),TIENS(5)
S IEN=$$SETNEW("LOC",.TIENS,.OBJ) I IEN'>0 Q
S TIENS(3)=IEN,IENS=$$BLDIENS(.TIENS),IARRAY(IENS)=""
D FDALOC(.OBJ,.FDA,IENS)
S IDX=0 F S IDX=$O(OBJ("Panels",IDX)) Q:IDX'>0 D
.K TOBJ M TOBJ=OBJ("Panels",IDX,"panelObject")
.D SETNEWITEM(.TOBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB)
Q
;
SETNEWPKG(OBJ,FDA,TIENS,IARRAY,TEMPSUB) ;
N DA,DIC,IDX,IEN,IENS,TOBJ,Y
K TIENS(2),TIENS(3),TIENS(4),TIENS(5)
S IEN=$$SETNEW("PKG",.TIENS,.OBJ) I IEN'>0 Q
S TIENS(2)=IEN,IENS=$$BLDIENS(.TIENS),IARRAY(IENS)=""
D FDAPKG(.OBJ,.FDA,IENS)
S IDX=0 F S IDX=$O(OBJ("locationId",IDX)) Q:IDX'>0 D
.K TOBJ M TOBJ=OBJ("locationId",IDX)
.D SETNEWLOC(.TOBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB)
Q
;
SETNEWDATA(OBJ,FDA,TIENS,IARRAY) ;
N DA,DIC,IEN,IENS,Y
K TIENS(5)
S IEN=$$SETNEW("REQD",.TIENS,.OBJ) I IEN'>0 Q
S TIENS(5)=IEN,IENS=$$BLDIENS(.TIENS),IARRAY(IENS)=""
Q
;
SETDATES(DATE,DATES) ;
S DATES("internal")=DATE
S DATES("external")=$$FMTE^XLFDT(DATE)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOREDITOR2 12052 printed May 25, 2026@12:34:27 Page 2
OREDITOR2 ; SLC/AGP - Info Panel Editor Code ;Dec 18, 2025@09:24:32
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
+2 ;
+3 ;
+4 QUIT
+5 ;
BLDDA(TIENS,DA) ;
+1 NEW CNT,IDX
+2 SET IDX=$ORDER(TIENS("A"),-1)
SET DA=TIENS(IDX)
+3 SET CNT=0
FOR
SET IDX=$ORDER(TIENS(IDX),-1)
if IDX<1
QUIT
Begin DoDot:1
+4
*** ERROR ***
SET DA($I(CNT))=TIENS(IDX)
End DoDot:1
+5 QUIT
+6 ;
BLDIENS(TIENS) ;
+1 NEW DA,RESULT
+2 DO BLDDA(.TIENS,.DA)
+3 SET RESULT=$$IENS^DILF(.DA)
+4 QUIT RESULT
+5 ;
GETIENS(RESULT,IENS) ;
+1 NEW X
+2 SET RESULT=""
FOR X=1:1:$LENGTH(IENS)-1
SET RESULT(X)=$PIECE(IENS,",",X)
+3 QUIT
+4 ;
DELETE(IARRAY) ;
+1 NEW ERROR,FDA,IENS,TIENS
+2 SET TIENS(1)=1
SET TIENS(2)=0
+3 FOR
SET TIENS(2)=$ORDER(^ORI(101.71,TIENS(1),"PKG",TIENS(2)))
if TIENS(2)'>0
QUIT
Begin DoDot:1
+4 KILL TIENS(3),TIENS(4),TIENS(5)
SET IENS=$$BLDIENS(.TIENS)
IF '$DATA(IARRAY(IENS))
SET FDA(101.711,IENS,.01)="@"
QUIT
+5 SET TIENS(3)=0
+6 FOR
SET TIENS(3)=$ORDER(^ORI(101.71,TIENS(1),"PKG",TIENS(2),"LOC",TIENS(3)))
if TIENS(3)'>0
QUIT
Begin DoDot:2
+7 KILL TIENS(4),TIENS(5)
SET IENS=$$BLDIENS(.TIENS)
IF '$DATA(IARRAY(IENS))
SET FDA(101.7112,IENS,.01)="@"
QUIT
+8 SET TIENS(4)=0
+9 FOR
SET TIENS(4)=$ORDER(^ORI(101.71,TIENS(1),"PKG",TIENS(2),"LOC",TIENS(3),"ITM",TIENS(4)))
if TIENS(4)'>0
QUIT
Begin DoDot:3
+10 KILL TIENS(5)
SET IENS=$$BLDIENS(.TIENS)
IF '$DATA(IARRAY(IENS))
SET FDA(101.71123,IENS,.01)="@"
QUIT
+11 SET TIENS(5)=0
+12 FOR
SET TIENS(5)=$ORDER(^ORI(101.71,TIENS(1),"PKG",TIENS(2),"LOC",TIENS(3),"ITM",TIENS(4),"REQD",TIENS(5)))
if TIENS(5)'>0
QUIT
Begin DoDot:4
+13 SET IENS=$$BLDIENS(.TIENS)
IF '$DATA(IARRAY(IENS))
SET FDA(101.714,IENS,.01)="@"
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF '$DATA(FDA)
QUIT ""
+15 DO UPDATE^DIE("","FDA","","ERROR")
+16 QUIT $SELECT($DATA(ERROR):"Error",1:"")
+17 ;
DIFF(HARRAY,IENS,OBJ) ;
+1 IF HARRAY(IENS)'=$$GENAREF^XLFSHAN(160,"OBJ",1)
QUIT 1
+2 QUIT 0
+3 ;
DIFFLOC(OBJ,FDA,TIENS,HARRAY,IARRAY,TEMPSUB) ;
+1 NEW IDX,IENS,TOBJ
+2 KILL TIENS(3),TIENS(4),TIENS(5)
+3 IF $GET(OBJ("locationId"))=""
DO SETNEWLOC(.OBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB)
QUIT
+4 ;S TIENS(3)=OBJ("id"),IENS=$$BLDIENS(.TIENS)
+5 SET IENS=OBJ("locationId")
SET IARRAY(IENS)=""
SET TIENS(3)=$PIECE(IENS,",")
+6 MERGE TOBJ=OBJ
KILL TOBJ("Panels")
IF $$DIFF(.HARRAY,IENS,.TOBJ)
DO FDALOC(.OBJ,.FDA,IENS)
+7 SET IDX=0
FOR
SET IDX=$ORDER(OBJ("Panels",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+8 KILL TOBJ
MERGE TOBJ=OBJ("Panels",IDX,"panelObject")
+9 DO DIFFITEM(.TOBJ,.FDA,.TIENS,.HARRAY,.IARRAY,.TEMPSUB)
End DoDot:1
+10 QUIT
+11 ;
DIFFITEM(OBJ,FDA,TIENS,HARRAY,IARRAY,TEMPSUB) ;
+1 NEW HRDATA,IDX,IENS,RDATA,TOBJ
+2 KILL TIENS(4),TIENS(5)
+3 IF $GET(OBJ("panelId"))=""
DO SETNEWITEM(.OBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB)
QUIT
+4 SET IENS=OBJ("panelId")
SET IARRAY(IENS)=""
SET TIENS(4)=$PIECE(IENS,",")
+5 MERGE RDATA=OBJ("actionObject","requiredData")
+6 SET HRDATA=$$HREQDATA(.RDATA)
+7 MERGE TOBJ=OBJ
KILL TOBJ("actionObject","requiredData")
+8 IF $$DIFF(.HARRAY,IENS,.TOBJ)
DO FDAITEM(.OBJ,.FDA,IENS,.TEMPSUB,HRDATA)
+9 SET IDX=0
FOR
SET IDX=$ORDER(OBJ("actionObject","requiredData",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+10 KILL TOBJ
MERGE TOBJ=OBJ("actionObject","requiredData",IDX)
+11 DO DIFFREQ(.TOBJ,.FDA,.TIENS,.HARRAY,.IARRAY)
End DoDot:1
+12 QUIT
+13 ;
DIFFREQ(OBJ,FDA,TIENS,HARRAY,IARRAY) ;
+1 NEW IENS
+2 KILL TIENS(5)
+3 IF $GET(OBJ("dataId"))=""
DO SETNEWDATA(.OBJ,.FDA,.TIENS,.IARRAY)
QUIT
+4 ;S TIENS(5)=OBJ("id"),IENS=$$BLDIENS(.TIENS),IARRAY(IENS)=""
+5 SET IENS=OBJ("dataId")
SET IARRAY(IENS)=""
+6 IF $$DIFF(.HARRAY,IENS,.OBJ)
DO FDAREQ(.OBJ,.FDA,IENS)
+7 QUIT
+8 ;
HREQDATA(ARRAY) ;
+1 NEW IDX,RESULT
+2 SET IDX=0
SET RESULT=0
+3 FOR
SET IDX=$ORDER(ARRAY(IDX))
if IDX'>0!(RESULT=1)
QUIT
Begin DoDot:1
+4 IF $GET(ARRAY("requiredForAction"))="true"
SET RESULT=1
End DoDot:1
+5 QUIT RESULT
+6 ;
FDAITEM(OBJ,FDA,IENS,TEMPSUB,RDATA) ;
+1 NEW CALLRPC,IDX,TMP,TOBJ,TEXT,TSUB
+2 SET TMP=""
+3 IF +$GET(OBJ("panelSequence"))=0
SET FDA(101.71123,IENS,.01)="@"
QUIT
+4 SET CALLRPC=$SELECT($GET(OBJ("actionObject","callRPC"))'="":OBJ("actionObject","callRPC"),1:"false")
+5 SET FDA(101.71123,IENS,.01)=OBJ("panelSequence")
+6 IF $GET(OBJ("panelName"))'=""
SET FDA(101.71123,IENS,.02)=$SELECT($GET(OBJ("panelName"))'="":OBJ("panelName"),1:"@")
+7 SET FDA(101.71123,IENS,.03)=$SELECT($GET(OBJ("status"))'="":OBJ("status"),1:"@")
+8 SET FDA(101.71123,IENS,.04)=$SELECT($GET(OBJ("panelAbbreviation"))'="":OBJ("panelAbbreviation"),1:"@")
+9 SET FDA(101.71123,IENS,.05)=$SELECT($GET(OBJ("defaultText"))'="":OBJ("defaultText"),1:"@")
+10 SET FDA(101.71123,IENS,.06)=$SELECT(+$GET(OBJ("backgroundColor","const"))>0:OBJ("backgroundColor","const"),1:"@")
+11 SET FDA(101.71123,IENS,.08)=$SELECT(+$GET(OBJ("imageIcon","const"))>0:OBJ("imageIcon","const"),1:"@")
+12 SET FDA(101.71123,IENS,10)=$SELECT($GET(OBJ("evaluationObject","evaluationType"))'="":OBJ("evaluationObject","evaluationType"),1:"@")
+13 SET FDA(101.71123,IENS,11)=$SELECT($GET(OBJ("evaluationObject","reminderComponent"))'="":OBJ("evaluationObject","reminderComponent"),1:"@")
+14 SET FDA(101.71123,IENS,12)=$SELECT($GET(OBJ("evaluationObject","reminderStatus"))'="":OBJ("evaluationObject","reminderStatus"),1:"@")
+15 SET FDA(101.71123,IENS,13)=$SELECT(+$GET(OBJ("evaluationObject","evaluationCode"))>0:OBJ("evaluationObject","evaluationCode"),1:"@")
+16 SET FDA(101.71123,IENS,20)=$SELECT($GET(OBJ("applicableObject","displayIfApplicable"))="true":1,1:0)
+17 SET FDA(101.71123,IENS,21)=$SELECT($GET(OBJ("applicableObject","notApplicableabbreviation"))'="":OBJ("applicableObject","notApplicableabbreviation"),1:"@")
+18 SET FDA(101.71123,IENS,22)=$SELECT($GET(OBJ("applicableObject","notApplicableText"))'="":OBJ("applicableObject","notApplicableText"),1:"@")
+19 SET FDA(101.71123,IENS,23)=$SELECT(+$GET(OBJ("applicableObject","backgroundColor","const"))>0:OBJ("applicableObject","backgroundColor","const"),1:"@")
+20 SET FDA(101.71123,IENS,24)=$SELECT(+$GET(OBJ("applicableObject","imageIcon","const"))>0:OBJ("applicableObject","imageIcon","const"),1:"@")
+21 SET FDA(101.71123,IENS,30)=$SELECT(+$GET(OBJ("actionObject","panelAction","const"))>0:OBJ("actionObject","panelAction","const"),1:"@")
+22 SET FDA(101.71123,IENS,31)=$SELECT($GET(OBJ("actionObject","formType"))'="":OBJ("actionObject","formType"),1:"@")
+23 SET FDA(101.71123,IENS,32)=$SELECT(+$GET(OBJ("actionObject","detailCode"))>0:OBJ("actionObject","detailCode"),1:"@")
+24 SET FDA(101.71123,IENS,34)=$SELECT(+$GET(OBJ("actionObject","editor","const"))>0:OBJ("actionObject","editor","const"),1:"@")
+25 IF +$GET(FDA(101.71123,IENS,34))>0
SET CALLRPC="true"
+26 SET FDA(101.71123,IENS,70)=$SELECT($GET(OBJ("actionObject","url"))'="":OBJ("actionObject","url"),1:"@")
+27 IF $GET(OBJ("actionObject","detailText"))=""
SET FDA(101.71123,IENS,50)="@"
+28 IF $GET(OBJ("description"))=""
SET FDA(101.71123,IENS,40)="@"
+29 IF $GET(OBJ("actionObject","detailText"))'=""
Begin DoDot:1
+30 KILL TEXT,TMP
MERGE TMP=OBJ("actionObject","detailText")
+31 DO PARSETEXT^OREDITOR1(.TEXT,.TMP)
+32 SET TSUB="IPANEL DETAIL "_IENS
+33 MERGE ^TMP(TSUB,$JOB)=TEXT
+34 SET FDA(101.71123,IENS,50)=$NAME(^TMP(TSUB,$JOB))
SET TEMPSUB(TSUB)=""
End DoDot:1
+35 IF $GET(OBJ("description"))'=""
Begin DoDot:1
+36 KILL TEXT,TMP
MERGE TMP=OBJ("description")
+37 DO PARSETEXT^OREDITOR1(.TEXT,.TMP)
+38 SET TSUB="IPANEL DESCRIPTION "_IENS
+39 MERGE ^TMP(TSUB,$JOB)=TEXT
SET FDA(101.71123,IENS,40)=$NAME(^TMP(TSUB,$JOB))
SET TEMPSUB(TSUB)=""
End DoDot:1
+40 IF +$GET(OBJ("actionObject","editor"))>0
SET CALLRPC="true"
+41 IF +$GET(OBJ("actionObject","detailCode"))>0
SET CALLRPC="true"
+42 IF RDATA=1
SET CALLRPC="true"
+43 SET FDA(101.71123,IENS,33)=CALLRPC
+44 QUIT
+45 ;
FDALOC(OBJ,FDA,IENS) ;
+1 NEW TMP
+2 IF +$GET(OBJ("locationSequence"))=0
SET FDA(101.7112,IENS,.01)="@"
QUIT
+3 SET FDA(101.7112,IENS,.01)=OBJ("locationSequence")
+4 SET FDA(101.7112,IENS,.02)=$SELECT(+$GET(OBJ("location","const"))>0:OBJ("location","const"),1:"@")
+5 SET FDA(101.7112,IENS,.03)=$SELECT($GET(OBJ("displayText"))'="":OBJ("displayText"),1:"@")
+6 SET FDA(101.7112,IENS,.04)=$SELECT($GET(OBJ("abbreviation"))'="":OBJ("abbreviation"),1:"@")
+7 SET FDA(101.7112,IENS,.05)=$SELECT(+$GET(OBJ("backgroundColor","const"))>0:OBJ("backgroundColor","const"),1:"@")
+8 SET FDA(101.7112,IENS,.06)=$SELECT($GET(OBJ("disabled"))'="":OBJ("disabled"),1:"@")
+9 SET FDA(101.7112,IENS,.07)=$SELECT($GET(OBJ("collapsible"))'="":OBJ("collapsible"),1:"@")
+10 SET FDA(101.7112,IENS,.08)=$SELECT(+$GET(OBJ("imageIcon","const"))>0:OBJ("imageIcon","const"),1:"@")
+11 QUIT
+12 ;
FDAPKG(OBJ,FDA,IENS) ;
+1 IF $GET(OBJ("package","title"))=""
SET FDA(101.711,IENS,.01)="@"
QUIT
+2 SET FDA(101.711,IENS,.01)=OBJ("package","const")
+3 QUIT
+4 ;
FDAREQ(OBJ,FDA,IENS) ;
+1 IF +$GET(OBJ("dataType","const"))=0
SET FDA(101.714,IENS,.01)="@"
QUIT
+2 SET FDA(101.714,IENS,.01)=OBJ("dataType","const")
+3 IF $GET(OBJ("requiredForAction"))'=""
SET FDA(101.714,IENS,.02)=$SELECT(OBJ("requiredForAction")="true":1,1:0)
+4 QUIT
+5 ;
IPANEL(INPUTS) ;
+1 IF INPUTS("callFrom")="editorSave"
QUIT $$SAVE(.INPUTS)
+2 IF INPUTS("callFrom")="editorBuilder"
QUIT $$BLD^OREDITOR4(.INPUTS)
+3 QUIT "0^Call from entry point not found."
+4 ;
SAVE(INPUTS) ;
+1 NEW DATA,FDA,ERROR,HARRAY,IARRAY,ID,IDX,LIDX,NIDX
+2 NEW OBJ,ORIMGR,PIDX,RIDX,SHARRAY,SUB,TIENS,TEMPSUB,TMPSUB,TSUB
+3 MERGE DATA=INPUTS("data")
+4 SET SUB=INPUTS("subscript")
+5 SET NIDX=$$GETNATIONAL^ORIUTL
IF NIDX=0
QUIT -1_U_"Could not find the National IDX"
+6 MERGE HARRAY=DATA("hashValues")
KILL DATA("hashValues")
+7 IF HARRAY("totalHash")=$$GENAREF^XLFSHAN(512,"DATA",1)
QUIT 1
+8 SET FDA(101.71,NIDX_",",.01)="NATIONAL"
+9 SET FDA(101.71,NIDX_",",.02)=$SELECT(DATA("active")="true":1,1:0)
+10 SET FDA(101.71,NIDX_",",.03)=$$NOW^XLFDT()
+11 ;S FDA(101.71,NIDX_",",.04)="CPRS Info Panel Update"
+12 DO SETHASHARRAY^OREDITOR1(.HARRAY,.SHARRAY)
+13 SET PIDX=0
+14 FOR
SET PIDX=$ORDER(DATA("ResponsiblePackages",PIDX))
if PIDX'>0
QUIT
Begin DoDot:1
+15 KILL TIENS
SET TIENS(1)=NIDX
SET IDX=0
+16 SET ID=$GET(DATA("ResponsiblePackages",PIDX,"packageId"))
IF ID'=""
SET IDX=$PIECE(ID,",")
+17 IF ID=""!(IDX=0)
MERGE OBJ=DATA("ResponsiblePackages",PIDX)
DO SETNEWPKG(.OBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB)
QUIT
+18 SET TIENS(2)=IDX
SET LIDX=0
SET IARRAY(ID)=""
+19 FOR
SET LIDX=$ORDER(DATA("ResponsiblePackages",PIDX,"locationId",LIDX))
if LIDX'>0
QUIT
Begin DoDot:2
+20 KILL OBJ
MERGE OBJ=DATA("ResponsiblePackages",PIDX,"locationId",LIDX)
+21 DO DIFFLOC(.OBJ,.FDA,.TIENS,.SHARRAY,.IARRAY,.TEMPSUB)
End DoDot:2
End DoDot:1
+22 SET ORIMGR=1
+23 IF $DATA(FDA)
DO FILE^DIE("","FDA","ERROR")
+24 IF +$GET(ERROR)>0
QUIT -1_U_"Error performing final update"
+25 IF $$DELETE(.IARRAY)'=""
QUIT -1_U_"Error removing records"
+26 SET TSUB=""
FOR
SET TSUB=$ORDER(TEMPSUB(TSUB))
if TSUB=""
QUIT
KILL ^TMP($JOB,TSUB)
+27 KILL OBJ,TMPSUB
MERGE TMPSUB=^ORI(101.71,NIDX)
+28 DO CHECKPANEL^ORICHECK(.OBJ,.TMPSUB)
IF $GET(OBJ("success"))'="true"
QUIT -1_U_"Failed final check after update. "_$CHAR(13)_$CHAR(10)_$GET(OBJ("error"))
+29 QUIT 1
+30 ;
SETNEW(TYPE,TIENS,OBJ) ;
+1 NEW CNT,DA,DIC,IDX,ORIMGR,TMP,X,Y
+2 SET DIC(0)="F"
+3 SET CNT=0
SET IDX="A"
FOR
SET IDX=$ORDER(TIENS(IDX),-1)
if IDX<1
QUIT
Begin DoDot:1
+4
*** ERROR ***
SET DA($I(CNT))=TIENS(IDX)
End DoDot:1
+5 IF TYPE="PKG"
Begin DoDot:1
+6 SET DIC="^ORI(101.71,"_DA(1)_",""PKG"","
+7 SET X=$GET(OBJ("package","const"))
End DoDot:1
+8 IF TYPE="LOC"
Begin DoDot:1
+9 SET DIC="^ORI(101.71,"_DA(2)_",""PKG"","_DA(1)_",""LOC"","
+10 SET TMP=OBJ("location","title")
+11 SET X=$GET(OBJ("locationSequence"))
SET DIC("DR")=".02///^S X=TMP"
End DoDot:1
+12 IF TYPE="ITM"
Begin DoDot:1
+13 SET DIC="^ORI(101.71,"_DA(3)_",""PKG"","_DA(2)_",""LOC"","_DA(1)_",""ITM"","
+14 SET X=$GET(OBJ("panelSequence"))
End DoDot:1
+15 IF TYPE="REQD"
Begin DoDot:1
+16 SET DIC="^ORI(101.71,"_DA(4)_",""PKG"","_DA(3)_",""LOC"","_DA(2)_",""ITM"","_DA(1)_",""REQD"","
+17 SET TMP=$SELECT(OBJ("requiredForAction")="true":1,1:0)
+18 SET X=$GET(OBJ("dataType","const"))
SET DIC("DR")=".02///^S X=TMP"
End DoDot:1
+19 IF +$GET(X)=0
QUIT 0
+20 SET ORIMGR=1
+21 DO FILE^DICN
+22 QUIT +$GET(Y)
+23 ;
SETNEWITEM(OBJ,FDA,TIENS,IARRAY,TEMPSUB) ;
+1 NEW DA,DIC,HRDATA,IDX,IEN,IENS,RDATA,RIDX,TOBJ,Y
+2 KILL TIENS(4),TIENS(5)
+3 SET IEN=$$SETNEW("ITM",.TIENS,.OBJ)
IF IEN'>0
QUIT
+4 SET TIENS(4)=IEN
SET IENS=$$BLDIENS(.TIENS)
SET IARRAY(IENS)=""
+5 MERGE RDATA=OBJ("actionObject","requiredData")
+6 SET HRDATA=$$HREQDATA(.RDATA)
+7 KILL TIENS(5)
DO FDAITEM(.OBJ,.FDA,.IENS,.TEMPSUB,HRDATA)
+8 SET IDX=0
FOR
SET IDX=$ORDER(OBJ("actionObject","requiredData",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+9 KILL TOBJ
MERGE TOBJ=OBJ("actionObject","requiredData",IDX)
+10 DO SETNEWDATA(.TOBJ,.FDA,.TIENS,.IARRAY)
End DoDot:1
+11 QUIT
+12 ;
SETNEWLOC(OBJ,FDA,TIENS,IARRAY,TEMPSUB) ;
+1 NEW DA,DIC,IDX,IEN,IENS,TOBJ,Y
+2 KILL TIENS(3),TIENS(4),TIENS(5)
+3 SET IEN=$$SETNEW("LOC",.TIENS,.OBJ)
IF IEN'>0
QUIT
+4 SET TIENS(3)=IEN
SET IENS=$$BLDIENS(.TIENS)
SET IARRAY(IENS)=""
+5 DO FDALOC(.OBJ,.FDA,IENS)
+6 SET IDX=0
FOR
SET IDX=$ORDER(OBJ("Panels",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+7 KILL TOBJ
MERGE TOBJ=OBJ("Panels",IDX,"panelObject")
+8 DO SETNEWITEM(.TOBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB)
End DoDot:1
+9 QUIT
+10 ;
SETNEWPKG(OBJ,FDA,TIENS,IARRAY,TEMPSUB) ;
+1 NEW DA,DIC,IDX,IEN,IENS,TOBJ,Y
+2 KILL TIENS(2),TIENS(3),TIENS(4),TIENS(5)
+3 SET IEN=$$SETNEW("PKG",.TIENS,.OBJ)
IF IEN'>0
QUIT
+4 SET TIENS(2)=IEN
SET IENS=$$BLDIENS(.TIENS)
SET IARRAY(IENS)=""
+5 DO FDAPKG(.OBJ,.FDA,IENS)
+6 SET IDX=0
FOR
SET IDX=$ORDER(OBJ("locationId",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+7 KILL TOBJ
MERGE TOBJ=OBJ("locationId",IDX)
+8 DO SETNEWLOC(.TOBJ,.FDA,.TIENS,.IARRAY,.TEMPSUB)
End DoDot:1
+9 QUIT
+10 ;
SETNEWDATA(OBJ,FDA,TIENS,IARRAY) ;
+1 NEW DA,DIC,IEN,IENS,Y
+2 KILL TIENS(5)
+3 SET IEN=$$SETNEW("REQD",.TIENS,.OBJ)
IF IEN'>0
QUIT
+4 SET TIENS(5)=IEN
SET IENS=$$BLDIENS(.TIENS)
SET IARRAY(IENS)=""
+5 QUIT
+6 ;
SETDATES(DATE,DATES) ;
+1 SET DATES("internal")=DATE
+2 SET DATES("external")=$$FMTE^XLFDT(DATE)
+3 QUIT
+4 ;
