Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OREDITOR1

OREDITOR1.m

Go to the documentation of this file. 
OREDITOR1 ; SLC/AGP - Core Editor Forms ;Dec 03, 2025@08:41:17

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39

 ;

 ; Reference to $$MAXBLANK^XMXUTIL1 supported by ICR # 2735

 ; Reference to FORMAT^PXRMTEXT supported by ICR # 7459

 ;

 Q

 ;

BLDFDA(FILENUM,GBL,NAME,DATA,ERROR,SHARRAY) ;

 N ADDCNT,DIDX,DIFF,FDA,IARRAY,IDX,IENS,KSUB,MSG,NODE,OBJ,ORIMGR,SUB,TEXT,UFDA,VALUE

 S ADDCNT=+$O(@GBL@("A"),-1)

 S DIDX=0 F  S DIDX=$O(DATA(NAME,DIDX)) Q:DIDX'>0  D

 .K OBJ M OBJ=DATA(NAME,DIDX)

 .S IDX=+$G(OBJ("id"))

 .I IDX>0,'$$DIFF(.OBJ,.SHARRAY,.IARRAY) Q

 .I IDX=0 S IDX=$$SETNEW(.OBJ,FILENUM,GBL,.IARRAY,.KSUB) I IDX=0 Q

 .S IENS=IDX_","

 .I FILENUM=101.73 D FDACOMPONENT(.OBJ,.FDA,.KSUB,IENS)

 .I FILENUM=101.75 D FDAPLUGIN(.OBJ,.FDA,.KSUB,IENS)

 .I FILENUM=101.76 D FDASCHEMA(.OBJ,.FDA,.KSUB,IENS)

BLDFDAX ;

 S ORIMGR=1

 I $D(FDA) D FILE^DIE("","FDA","MSG")

 I $D(MSG) S ERROR="Error updating "_NAME_" file"

 I $D(IARRAY) D DELETE(GBL,.IARRAY)

 S SUB="" F  S SUB=$O(KSUB(SUB)) Q:SUB=""  K ^TMP(SUB,$J)

 Q

 ;

DELETE(GBL,IARRAY) ;

 N DA,DIK,ORIMGR

 S DIK=$E(GBL,1,$L(GBL)-1)_","

 S DA=0 F  S DA=$O(@GBL@(DA)) Q:DA'>0  D

 .I '$D(IARRAY(DA)) S ORIMGR=1 D ^DIK

 Q

 ;

COMPAREANDSET(INPUTS,DATA,HARRAY,SUB,SHARRAY) ;

 M DATA=INPUTS("data")

 M HARRAY=DATA("hashValues") K DATA("hashValues")

 M DATA=INPUTS("data",SUB),HARRAY=DATA("hashValues") K DATA("hashValues")

 I HARRAY("totalHash")=$$GENAREF^XLFSHAN(512,"DATA",1) Q 1

 D SETHASHARRAY(.HARRAY,.SHARRAY)

 Q 0

 ;

COMPONENTS(INPUTS) ;

 I INPUTS("callFrom")="editorSave" Q $$COMPONENTSAVE(.INPUTS)

 I INPUTS("callFrom")="editorBuilder" Q $$COMPONENTBLD(.INPUTS)

 Q "0^Call from entry point not found."

 ;

COMPONENTBLD(INPUTS) ;

 N ARRAY,CACHESUB,CNT,DIDX,DSCHEMA,DFN,HARRAY,IDX,ITEM,MARRAY,NAME,NODE,PIDX

 N SCHEMA,STR,SUB,TSCHEMA,UISCHEMA,USER

 D PASSINVALUES(.INPUTS,.DSCHEMA,.DFN,.PIDX,.SCHEMA,.SUB,.UISCHEMA,.USER,.CACHESUB)

 D CODE^ORIUTL(.ARRAY,101.73,1)

 D CODE^ORIUTL(.MARRAY,101.734,1)

 M SCHEMA("properties","components","items","properties","componentType","oneOf")=ARRAY

 M SCHEMA("properties","components","items","properties","neededData","items","properties","mandatoryData","oneOf")=MARRAY

 S NAME="",CNT=0 F  S NAME=$O(^ORI(101.73,"B",NAME)) Q:NAME=""  D

 .S IDX=0 F  S IDX=$O(^ORI(101.73,"B",NAME,IDX)) Q:IDX'>0  D

 ..K ITEM D GETITEM(.ITEM,IDX,101.73)

 ..D SETHASH(.HARRAY,IDX,.ITEM)

 ..S CNT=CNT+1 M TSCHEMA("components",CNT)=ITEM

 D SETHASHTOTAL(.DSCHEMA,.HARRAY,.TSCHEMA)

 M DSCHEMA=TSCHEMA

 D SETFINALTMP(SUB,.SCHEMA,.UISCHEMA,.DSCHEMA)

 Q 1

 ;

COMPONENTSAVE(INPUTS) ;

 N DATA,ERROR,HARRAY,IDX,OBJ,RESULT,SHARRAY

 S ERROR="",RESULT=1

 I $$COMPAREANDSET(.INPUTS,.DATA,.HARRAY,"components",.SHARRAY)=1 Q 1

 D BLDFDA(101.73,"^ORI(101.73)","components",.DATA,.ERROR,.SHARRAY)

 I ERROR'="" S RESULT=-1_U_ERROR

 Q RESULT

 ;

DIFF(OBJ,HARRAY,IARRAY) ;

 S IARRAY(OBJ("id"))=""

 I HARRAY(OBJ("id"))'=$$GENAREF^XLFSHAN(160,"OBJ",1) Q 1

 Q 0

 ;

GETITEM(ITEM,IDX,FN) ;

 N NODE,STR,TEXT,TIDX

 I FN=101.75 D  Q

 .S NODE=$G(^OR(101.75,IDX,0))

 .S ITEM("id")=IDX,ITEM("name")=$P(NODE,U)

 .S ITEM("routine")=$P(NODE,U,2),ITEM("entryPoint")=$P(NODE,U,3)

 .I $P(NODE,U,4)'="" S ITEM("pluginType")=$P(NODE,U,4)

 .S ITEM("mandatoryParameter")=$S($P(NODE,U,5)=1:"true",1:"false")

 .I $P($G(^OR(101.75,IDX,10)),U)'="" S ITEM("shortDescription")=$P($G(^OR(101.75,IDX,10)),U)

 .K STR M TEXT=^OR(101.75,IDX,20) S STR=$$SETTEXT(.TEXT) I STR'="" S ITEM("description")=STR

 I FN=101.73 D  Q

 .S NODE=$G(^ORI(101.73,IDX,0))

 .S ITEM("id")=IDX,ITEM("name")=$P(NODE,U),ITEM("componentType")=$P(NODE,U,2)

 .S ITEM("componentName")=$P(NODE,U,3)

 .S NODE=$G(^ORI(101.73,IDX,30)) I NODE'="" S ITEM("errorMessageText")=NODE

 .S NODE=$G(^ORI(101.73,IDX,"CPRS")) I $P(NODE,U)'="" S ITEM("pageId")=+NODE

 .S TIDX=0 F  S TIDX=$O(^ORI(101.73,IDX,40,TIDX)) Q:TIDX'>0  D

 ..S NODE=$G(^ORI(101.73,IDX,40,TIDX,0))

 ..S ITEM("neededData",TIDX,"dataId")=$P(NODE,U)

 ..I $P(NODE,U,2)'="" S ITEM("neededData",TIDX,"mandatoryParameter")=$P(NODE,U,2)

 .K STR,TEXT M TEXT=^ORI(101.73,IDX,50) S STR=$$SETTEXT(.TEXT) I STR'="" S ITEM("itemIcon")=STR

 .K STR,TEXT M TEXT=^ORI(101.73,IDX,20) S STR=$$SETTEXT(.TEXT) I STR'="" S ITEM("description")=STR

 I FN=101.76 D

 .S NODE=$G(^ORW(101.76,IDX,0))

 .S ITEM("id")=IDX,ITEM("name")=$P(NODE,U)

 .S ITEM("contentType")=$P(NODE,U,2)

 .S ITEM("reservedSystem")=$S($P(NODE,U,3)=1:"true",1:"false")

 .M TEXT=^ORW(101.76,IDX,1) S STR=$$SETTEXT(.TEXT) I STR'="" S ITEM("content")=STR

 Q

 ;

FDACOMPONENT(OBJ,FDA,KSUB,IENS) ;

 N DA,DIK,RCNT,REQ,TEXT,RIDX,RIENS,TMP,TSUB

 S FDA(101.73,IENS,.01)=$S($G(OBJ("name"))'="":OBJ("name"),1:"@")

 S FDA(101.73,IENS,1)=$S($G(OBJ("componentType"))'="":OBJ("componentType"),1:"@")

 S FDA(101.73,IENS,2)=$G(OBJ("componentName"))

 S FDA(101.73,IENS,30)=$G(OBJ("errorMessageText"))

 S FDA(101.73,IENS,60)=$S($G(OBJ("pageId"))'="":OBJ("pageId"),1:"@")

 K TEXT,TMP M TMP=OBJ("imageIcon") D PARSETEXT(.TEXT,.TMP)

 I $D(TEXT) S TSUB="IMAGE "_IENS M ^TMP(TSUB,$J)=TEXT S KSUB(TSUB)="",FDA(101.73,IENS,50)=$NA(^TMP(TSUB,$J))

 K TEXT,TMP M TMP=OBJ("description") D PARSETEXT(.TEXT,.TMP)

 I $D(TEXT) S TSUB="DESCRIPTION "_IENS M ^TMP(TSUB,$J)=TEXT S KSUB(TSUB)="",FDA(101.73,IENS,20)=$NA(^TMP(TSUB,$J))

 S DA(1)=+IENS,DIK="^ORI(101.74,"_DA(1)_",40,"

 S DA=0 F  S DA=$O(^ORI(101.74,DA(1),40,DA)) Q:DA'>0  D ^DIK

 S RIDX=0,RCNT=800 F  S RIDX=$O(OBJ("neededData",RIDX)) Q:RIDX'>0  D

 .I $G(OBJ("neededData",RIDX,"dataId"))="" Q

 .S RIENS="+"_$I(RCNT)_","_IENS

 .S FDA(101.734,RIENS,.01)=OBJ("neededData",RIDX,"dataId")

 .S FDA(101.734,RIENS,1)=$G(OBJ("neededData",RIDX,"mandatoryData"))

 Q

 ;

FDAPLUGIN(OBJ,FDA,KSUB,IENS) ;

 N TEXT,TMP,TSUB

 S FDA(101.75,IENS,.01)=$S($G(OBJ("name"))'="":OBJ("name"),1:"@")

 S FDA(101.75,IENS,1)=$G(OBJ("routine"))

 S FDA(101.75,IENS,2)=$G(OBJ("entryPoint"))

 S FDA(101.75,IENS,3)=$G(OBJ("type"))

 S FDA(101.75,IENS,4)=$S($G(OBJ("manatoryParameter"))="true":1,1:0)

 S FDA(101.75,IENS,10)=$G(OBJ("shortDescription"))

 M TMP=OBJ("description")

 K TEXT D PARSETEXT(.TEXT,.TMP)

 I $D(TEXT) S TSUB="DESCRIPTION "_IENS M ^TMP($J,TSUB)=TEXT S KSUB(TSUB)="",FDA(101.75,IENS,20)=$NA(^TMP(TSUB,$J))

 Q

 ;

FDASCHEMA(OBJ,FDA,KSUB,IENS) ;

 N TEXT,TMP,TSUB

 S FDA(101.76,IENS,.01)=OBJ("name")

 S FDA(101.76,IENS,.02)=$S($G(OBJ("contentType"))'="":OBJ("contentType"),1:"@")

 S FDA(101.76,IENS,.03)=$S($G(OBJ("reservedSystem"))="true":1,1:0)

 M TMP=OBJ("content")

 D PARSETEXT(.TEXT,.TMP,1)

 I $D(TEXT) S TSUB="content "_IENS M ^TMP(TSUB,$J)=TEXT S KSUB(TSUB)="",FDA(101.76,IENS,1)=$NA(^TMP(TSUB,$J))

 Q

 ;

PARSETEXT(OUTPUT,VALUE,STRIP) ;

 N CNT,IDX,PIECES,HASTEXT,TEMP,TEXTIN,TEXTOUT,NOUT,NTEXT,X

 S STRIP=+$G(STRIP)

 I $G(VALUE)="" Q

 S CNT=0

 S TEMP=$S(STRIP=1:$$MAXBLANK^XMXUTIL1(VALUE),1:VALUE)

 D NEWLINES(.TEXTIN,.CNT,TEMP)

 S IDX=0 F  S IDX=$O(VALUE("\",IDX)) Q:IDX'>0  D

 . S TEMP=$S(STRIP=1:$$MAXBLANK^XMXUTIL1(VALUE("\",IDX)),1:VALUE("\",IDX))

 . D NEWLINES(.TEXTIN,.CNT,TEMP)

 I CNT=0 Q

 ;TODO: Update look at pulling the width from schema, not needed now an most likely not needed at all

 D FORMAT^PXRMTEXT(1,80,CNT,.TEXTIN,.NOUT,.TEXTOUT)

 F X=1:1:NOUT S OUTPUT(X,0)=TEXTOUT(X)

 Q

 ;

NEWLINES(OUTPUT,CNT,VALUE) ;

 N PIECES,X

 S PIECES=$L(VALUE,$C(10))

 F X=1:1:PIECES D

 .S CNT=CNT+1,OUTPUT(CNT)=$P(VALUE,$C(10),X)_"\\"

 Q

 ;

PASSINVALUES(INPUTS,DATA,DFN,PIDX,SCHEMA,SUB,UISCHEMA,USER,CACHESUB) ;

 M SCHEMA=INPUTS("schema"),UISCHEMA=INPUTS("uiSchema"),DATA=INPUTS("data")

 S DFN=INPUTS("sourceInputs","patient"),PIDX=INPUTS("sourceInputs","id"),USER=INPUTS("sourceInputs","connectedUser")

 s SUB=INPUTS("subscript"),CACHESUB=$G(INPUTS("cacheSub"))

 Q

 ;

PLUGIN(INPUTS) ;

 I INPUTS("callFrom")="editorSave" Q $$PLGSAVE(.INPUTS)

 I INPUTS("callFrom")="editorBuilder" Q $$PLGBLD(.INPUTS)

 Q "0^Call from entry point not found."

 ;

PLGBLD(INPUTS) ;

 N ARRAY,CACHESUB,CNT,DIDX,DSCHEMA,DFN,HARRAY,IDX,ITEM,NAME,NODE,PIDX

 N SCHEMA,STR,SUB,TSCHEMA,UISCHEMA,USER

 D PASSINVALUES(.INPUTS,.DSCHEMA,.DFN,.PIDX,.SCHEMA,.SUB,.UISCHEMA,.USER,.CACHESUB)

 D CODE^ORIUTL(.ARRAY,101.75,3)

 M SCHEMA("properties","plugins","items","properties","pluginType","oneOf")=ARRAY

 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

 ..K ITEM D GETITEM(.ITEM,IDX,101.75)

 ..D SETHASH(.HARRAY,IDX,.ITEM)

 ..S CNT=CNT+1 M TSCHEMA("plugins",CNT)=ITEM

 D SETHASHTOTAL(.DSCHEMA,.HARRAY,.TSCHEMA)

 M DSCHEMA=TSCHEMA

 D SETFINALTMP(SUB,.SCHEMA,.UISCHEMA,.DSCHEMA)

 Q 1

 ;

PLGSAVE(INPUTS) ;

 N CIDX,DATA,ERROR,FDA,HARRAY,IDX,MSG,NAME,NEWITEM,OLDITEM,RESULT,SHARRAY

 S ERROR="",RESULT=1

 I $$COMPAREANDSET(.INPUTS,.DATA,.HARRAY,"plugins",.SHARRAY)=1 Q 1

 D BLDFDA(101.75,"^OR(101.75)","plugins",.DATA,.ERROR,.SHARRAY)

 I ERROR'="" S RESULT=-1_U_ERROR

 Q RESULT

 ;

SCHEMA(INPUTS) ;

 I INPUTS("callFrom")="editorSave" Q $$SCHEMASAVE(.INPUTS)

 I INPUTS("callFrom")="editorBuilder" Q $$SCHEMABLD(.INPUTS)

 Q "0^Call from entry point not found."

 ;

SCHEMABLD(INPUTS) ;

 N CACHESUB,CNT,CIDX,DATA,DSCHEMA,DFN,HARRAY,IDX,ITEM,NAME,NODE,PIDX

 N SCHEMA,STR,SUB,UISCHEMA,USER,TSCHEMA

 D PASSINVALUES(.INPUTS,.DSCHEMA,.DFN,.PIDX,.SCHEMA,.SUB,.UISCHEMA,.USER,.CACHESUB)

 ;build ENUM types for schema

 S NAME="",CNT=0 F  S NAME=$O(^ORW(101.77,"B",NAME)) Q:NAME=""  D

 .S IDX=0 F  S IDX=$O(^ORW(101.77,"B",NAME,IDX)) Q:IDX'>0  D

 ..S CNT=CNT+1

 ..S SCHEMA("properties","schemas","items","properties","contentType","oneOf",CNT,"const")=IDX

 ..S SCHEMA("properties","schemas","items","properties","contentType","oneOf",CNT,"title")=NAME

 ;

 ;build data array

 S CNT=0

 S NAME="" F  S NAME=$O(^ORW(101.76,"B",NAME)) Q:NAME=""  D

 .S IDX=0 F  S IDX=$O(^ORW(101.76,"B",NAME,IDX)) Q:IDX'>0  D

 ..K ITEM D GETITEM(.ITEM,IDX,101.76)

 ..D SETHASH(.HARRAY,IDX,.ITEM)

 ..S CNT=CNT+1 M TSCHEMA("schemas",CNT)=ITEM

 D SETHASHTOTAL(.DSCHEMA,.HARRAY,.TSCHEMA)

 M DSCHEMA=TSCHEMA

 D SETFINALTMP(SUB,.SCHEMA,.UISCHEMA,.DSCHEMA)

 Q 1

 ;

SCHEMASAVE(INPUTS) ;

 N DATA,ERROR,HARRAY,RESULT,SHARRAY

 S ERROR="",RESULT=1

 I $$COMPAREANDSET(.INPUTS,.DATA,.HARRAY,"schemas",.SHARRAY)=1 Q 1

 D BLDFDA(101.76,"^ORW(101.76)","schemas",.DATA,.ERROR,.SHARRAY)

 I $G(ERROR)'="" S RESULT=-1_U_ERROR

 Q RESULT

 ;

SETFINALTMP(SUB,SCHEMA,UISCHEMA,DSCHEMA) ;

 M ^TMP(SUB,$J,"Schema")=SCHEMA

 M ^TMP(SUB,$J,"UISchema")=UISCHEMA

 M ^TMP(SUB,$J,"Data")=DSCHEMA

 S ^TMP(SUB,$J,"success")="true"

 Q

 ;

SETHASHARRAY(HARRAY,SHARRAY) ;

 N IDX

 S IDX=0 F  S IDX=$O(HARRAY("hashes",IDX)) Q:IDX'>0  D

 .S SHARRAY(HARRAY("hashes",IDX,"id"))=HARRAY("hashes",IDX,"value")

 Q

 ;

SETHASH(HARRAY,ID,OBJ) ;

 N CNT

 S CNT=+$O(HARRAY("A"),-1)

 S CNT=$I(CNT)

 S HARRAY(CNT,"id")=ID

 S HARRAY(CNT,"value")=$$GENAREF^XLFSHAN(160,"OBJ",1)

 Q

 ;

SETHASHTOTAL(DSCHEMA,HARRAY,OBJ) ;

 S DSCHEMA("hashValues","totalHash")=$$GENAREF^XLFSHAN(512,"OBJ",1)

 M DSCHEMA("hashValues","hashes")=HARRAY

 Q

 ;

SETNEW(OBJ,FN,GBL,IARRAY,KSUB) ;

 N ERROR,FDA,IEN,IENS,IENARRAY,RESULT

 S IEN=$O(@GBL@("A"),-1)+1

 S IENS="+"_IEN_","

 I FN=101.73 D FDACOMPONENT(.OBJ,.FDA,.KSUB,IENS)

 I FN=101.75 D FDAPLUGIN(.OBJ,.FDA,.KSUB,IENS)

 I FN=101.76 D FDASCHEMA(.OBJ,.FDA,.KSUB,IENS)

 D UPDATE^DIE("","FDA","IENARRAY","ERROR")

 I $D(ERROR) Q 0

 S IARRAY(+$G(IENARRAY(IEN)))=""

 Q $G(IENARRAY(IEN))

 ;

SETTEXT(TEXT) ;

 N IDX,LIDX,RESULT

 S RESULT="",LIDX=+$O(TEXT("A"),-1)

 S IDX=0 F  S IDX=$O(TEXT(IDX)) Q:IDX'>0  D

 .S RESULT=RESULT_$G(TEXT(IDX,0))_$S(IDX<LIDX:$C(13)_$C(10),1:"")

 Q RESULT