ORIMGR ; SLC/AGP - Information panel VISTA manager ;Jun 11, 2025@08:21:33
;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
;
; Reference to FORMAT^PXRMTEXT supported by DBIA # 6935
;
Q
;
BLDIARRAY(TIDX,PKGIDX,IARRAY) ;
N CNT,NODE,PCNT,PIDX,PSEQ,SCNT,SSEQ,SIDX
K IARRAY
S SSEQ=0,SCNT=0,CNT=0
F S SSEQ=$O(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC","B",SSEQ)) Q:SSEQ'>0 D
.S SIDX=0
.F S SIDX=$O(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC","B",SSEQ,SIDX)) Q:SIDX'>0 D
..S NODE=$G(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,0)),SCNT=SCNT+1
..S IARRAY("sections",SCNT,"id")=SIDX,IARRAY("sections",SCNT,"name")=$P($G(^ORI(101.73,$P(NODE,U,2),0)),U)
..S IARRAY("sections",SCNT,"seq")=SSEQ
..S IARRAY("sectionSequence",SSEQ)=SCNT
..S IARRAY("sectionIdSequence",SIDX)=SCNT
..S PSEQ=0,PCNT=0
..F S PSEQ=$O(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,"ITM","B",PSEQ)) Q:PSEQ'>0 D
...S PIDX=0
...F S PIDX=$O(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,"ITM","B",PSEQ,PIDX)) Q:PIDX'>0 D
....S NODE=$G(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,"ITM",PIDX,0))
....S PCNT=PCNT+1
....S IARRAY("sections",SCNT,"items",PCNT,"id")=PIDX
....S IARRAY("sections",SCNT,"items",PCNT,"name")=$P(NODE,U,2)
....S IARRAY("sections",SCNT,"items",PCNT,"seq")=PSEQ
....S IARRAY("sectionSequence",SSEQ,"itemSequence",PSEQ)=PCNT
....S IARRAY("itemSequence","section",SSEQ)=SCNT
Q
;
FINDBYNAME(FILE,PROMPT,SCREEN,DICZERO,DLAYGO) ;
N DIC,DTOUT,DUOUT,Y
S DIC=FILE
I SCREEN'="" S DIC("S")=SCREEN
S DIC("A")=PROMPT
S DIC(0)=$S($G(DICZERO)'="":DICZERO,1:"AEMQ")
D ^DIC
I ($D(DTOUT)) S Y=U
I ($D(DUOUT)) S Y="^^"
Q Y
;
FORMATLONGTEXT(LABEL,TEXTIN,NUM,LM,RM,PAD,SUB,CNT) ;
;use for inquiry, build word-processing fields to be used later
;because of DIWP API
;
N IDX,NBL,NLINES,TEXTOUT,TMP
I RM<1 S RM=50
S NBL=0
S TMP=$$RJ^XLFSTR(LABEL,LM,PAD) I NUM=0 S CNT=CNT+1,^TMP(SUB,$J,CNT)=TMP Q
D FORMAT^PXRMTEXT(0,RM,NUM,.TEXTIN,.NLINES,.TEXTOUT)
F IDX=1:1:NLINES D
.I IDX=1 S TMP=TMP_TEXTOUT(IDX) D SETTEXT(TMP,"",SUB,.CNT,LM,PAD) Q
.S TMP=$$RJ^XLFSTR(" ",LM,PAD)_TEXTOUT(IDX),NBL=1 D SETTEXT(TMP,"",SUB,.CNT,LM,PAD)
I NBL=1 S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
Q
;
N TEMP,TEXTLEN,TEXTUND
S TEXTUND=$TR($J("",IOM)," ","-")
S TEMP=$$NOW^XLFDT_" Page "_DC
S TEXTLEN=$L(TEMP)
W TEXT
W ?(IOM-TEXTLEN),TEMP
W !,TEXTUND,!!
Q
;
INQ(DIC,DA,FLDS,HTEXT) ;
N BY,CNT,DC,DHD,FR,IDX,L,NOW,TO
S L=0
S BY="NUMBER"
S (FR,TO)=+DA
I $L(HTEXT)>0 D
. S NOW=$$NOW^XLFDT
. S NOW=$$FMTE^XLFDT(NOW,"1P")
. S DHD="W ?0 D HEADER^ORIMGR("""_HTEXT_""")"
E S DHD="@@"
D EN1^DIP
Q
;
INQPANEL ;
N CNT,DIWF,DIWL,END,FILL,HEAD,NAME,NODE,SECSEQ,SIDX,SUB,X
S DIWF="C80N",DIWL=2,CNT=0
S SUB="ORIMGR INQPANEL" K ^TMP(SUB,$J)
S SECSEQ=0
F S SECSEQ=$O(^ORI(101.71,D1,"PKG",D0,"LOC","B",SECSEQ)) Q:SECSEQ'>0 D
.S SIDX=$O(^ORI(101.71,D1,"PKG",D0,"LOC","B",SECSEQ,"")) Q:SIDX'>0
.S NODE=$G(^ORI(101.71,D1,"PKG",D0,"LOC",SIDX,0))
.S NAME=$P($G(^ORI(101.73,$P(NODE,U,2),0)),U)
.S HEAD="--- Begin Section Sequence: "_SECSEQ_" -"
.S FILL=75-$L(HEAD) F X=1:1:FILL S HEAD=HEAD_"-"
.S CNT=CNT+1,^TMP(SUB,$J,CNT)=$$RJ^XLFSTR(HEAD,75," ")
.D INQSECTION(D1,D0,SIDX,SUB,.CNT)
.S END="--- End Section Sequence: "_SECSEQ_" -"
.S FILL=75-$L(END) F X=1:1:FILL S END=END_"-"
.S CNT=CNT+1,^TMP(SUB,$J,CNT)=$$RJ^XLFSTR(END,75," ")
.S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
S CNT=0 F S CNT=$O(^TMP(SUB,$J,CNT)) Q:CNT'>0 D
.S X=^TMP(SUB,$J,CNT) D ^DIWP
Q
;
OTHERFILES(FN) ;
N ACT,DA,DIE,DIDEL,DINUSE,DR,FLDS,GBL,HEAD,PRMPT,ISNEW,NAME,PNAME,TNAME,Y
S GBL=$S(FN=101.75:"^OR(101.75,",FN=101.73:"^ORI(101.73,",FN=101.74:"^ORE(101.74,",1:"") I GBL="" Q
S PRMPT="Select "_$S(FN=101.75:"plugin: ",FN=101.73:"component: ",1:"editor: ")
S TNAME=$S(FN=101.75:"[OR EDIT M PLUGIN]",FN=101.73:"[ORI EDIT COMPONENT]",1:"[ORE EDIT EDITOR]")
S PNAME=$S(FN=101.75:"[OR PRINT M PLUGIN]",FN=101.73:"[ORI PRINT COMPONENT]",1:"[ORE PRINT EDITOR]")
S HEAD=$S(FN=101.75:"OR PRINT M PLUGIN",FN=101.73:"ORI PRINT COMPONENT",1:"ORE PRINT EDITOR")
S DA=$$FINDBYNAME(GBL,PRMPT,"",$S($G(ORIMGR)=1:"AELMQ",1:"AEMQ"),FN)
I +DA'>0 Q
S NAME=$P(DA,U,2),ISNEW=$P(DA,U,3)
S DA=+DA
D INQ(GBL,DA,PNAME,HEAD)
Q
;
PANELUI ;
;S ORIMGR=1
N ASK,CNT,DA,DIWF,DIWL,IARRAY,NAME,PKG,PKGIDX,SIDX,SUB,TIDX,TMP
S TIDX=+$O(^ORI(101.71,"B","NATIONAL","")) I TIDX=0 W !,"Cannot find national panel entry." Q
S PKG=$$LU^ORIRPC(9.4,"ORDER ENTRY/RESULTS REPORTING","X") I +PKG<1 W !,"Could not find the ORDER ENTRY/RESULTS REPORTING package file entry." Q
S PKGIDX=+$O(^ORI(101.71,TIDX,"PKG","B",PKG,"")) I PKGIDX=0 W !,"Could not find the ORDER ENTRY/RESULTS REPORTING entry in the National entry." Q
D BLDIARRAY(TIDX,PKGIDX,.IARRAY)
S DA(1)=TIDX,DA=PKGIDX,NAME=$P($G(^ORI(101.71,TIDX,0)),U)
S ASK=$$YESNO("View entire "_NAME_" entry",3) I +ASK<0 Q
I +ASK=1 D INQ("^ORI(101.71,",.DA,"[ORI PANEL INQUIRY]","Information Panel Inquiry") Q
S DIWF="C80N",DIWL=2
D SHOWSECTIONS(.IARRAY)
S ASK=$$PROMPTSECTION(TIDX,PKGIDX,"QEA","") I +ASK<1 Q
S SIDX=+ASK
S TMP=$P($G(^ORI(101.73,$P($G(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,0)),U,2),0)),U)
S ASK=$$YESNO("View entire "_TMP_" entry",3) I +ASK<0 Q
S SUB="ORIMGR INQASK",CNT=0 K ^TMP(SUB,$J)
I ASK=1 D INQSECTION(TIDX,PKGIDX,SIDX,SUB,.CNT) G INQASKX
D SHOWITEMS(.IARRAY,SIDX)
S ASK=$$PROMPTITEM^ORIMGR(TIDX,PKGIDX,SIDX,"QEA","") I ASK<0 Q
I ASK>0 D INQITEM(TIDX,PKGIDX,SIDX,+ASK,SUB,.CNT)
INQASKX ;
W !
S CNT=0 F S CNT=$O(^TMP(SUB,$J,CNT)) Q:CNT'>0 W !,^TMP(SUB,$J,CNT)
Q
INQITEM(TIDX,PIDX,SIDX,IIDX,SUB,CNT) ;
N CDRPC,CL,EDITOR,END,ETYPE,FN,HEAD,IMG,NAME,NODE,NOTAPP,NUM,IDX,RIDX,RIEN,TEXTIN,TMP
S NODE=$G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,0))
;Default values for information item
S EDITOR=0
S NAME=$P(NODE,U,2)
D SETTEXT("Name: ",NAME,SUB,.CNT,28," ")
D SETTEXT("Status: ",$S($P(NODE,U,3)="false":"DISABLED",$P(NODE,U,3)="locked":"LOCKED FOR EDITING",1:"ENABLED"),SUB,.CNT,28," ")
I $P(NODE,U,7)'="" D SETTEXT("Mandatory: ",$S($P(NODE,U,7)=1:"YES",1:"NO"),SUB,.CNT,28," ")
K TEXTIN
S IDX=0,NUM=0 F S IDX=$O(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DESC",IDX)) Q:IDX'>0 D
.S TEXTIN(IDX)=^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DESC",IDX,0),NUM=NUM+1
D FORMATLONGTEXT("Description: ",.TEXTIN,NUM,28,42," ",SUB,.CNT)
K TEXTIN
S TEXTIN(1)=$P(NODE,U,5)
D FORMATLONGTEXT("Display Text: ",.TEXTIN,1,28,42," ",SUB,.CNT)
S CL=$S(+$P(NODE,U,6)>0:$P($G(^ORI(101.73,$P(NODE,U,6),0)),U),1:"")
S IMG=$S(+$P(NODE,U,8)>0:$P($G(^ORI(101.73,$P(NODE,U,8),0)),U),1:"")
D SETTEXT("Abbreviation: ",$P(NODE,U,4),SUB,.CNT,28," ")
D SETTEXT("Color: ",CL,SUB,.CNT,28," ")
D SETTEXT("Image: ",IMG,SUB,.CNT,28," ")
;
;Evaluation Items
S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
S NODE=$G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,10))
S ETYPE=$S($P(NODE,U)="C":"Code",$P(NODE,U)="RD":"Reminder Definition",$P(NODE,U)="RT":"Reminder Term",1:"None")
D SETTEXT("Evaluation Type: ",ETYPE,SUB,.CNT,28," ")
I ETYPE["R" D
.S TMP=$S($P(NODE,U,2)["PXRMD(811.5":"RT.",1:"RD."),FN=+$P($P(NODE,U,2),"(",2)
.D SETTEXT("Reminder Component: ",TMP_$$GET1^DIQ(FN,+$P(NODE,U,2)_",",.01),SUB,.CNT,28," ")
.S TMP=$P(NODE,U,3) D SETTEXT("Reminder Status: ",$S(TMP="T":"True",TMP="F":"False",TMP="D":"Due",TMP="A":"Applicable",TMP="N":"N/A",1:""),SUB,.CNT,28," ")
I $P(NODE,U)="C",+$P(NODE,U,4)>0 S TMP=$P($G(^OR(101.75,$P(NODE,U,4),0)),U) D SETTEXT("Evaluation Code: ",TMP,SUB,.CNT,28," ")
;
;Applicable Values
S NODE=$G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,20))
S CL=$S(+$P(NODE,U,4)>0:$P($G(^ORI(101.73,$P(NODE,U,4),0)),U),1:"")
S IMG=$S(+$P(NODE,U,5)>0:$P($G(^ORI(101.73,$P(NODE,U,5),0)),U),1:"")
S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
K TEXTIN S TEXTIN(1)=$P(NODE,U,3)
D FORMATLONGTEXT("Applicable Display Text: ",.TEXTIN,1,28,42," ",SUB,.CNT)
S CL=$S(+$P(NODE,U,6)>0:$P($G(^ORI(101.73,$P(NODE,U,6),0)),U),1:"")
S IMG=$S(+$P(NODE,U,8)>0:$P($G(^ORI(101.73,$P(NODE,U,8),0)),U),1:"")
D SETTEXT("Applicable Abbreviation: ",$P(NODE,U,4),SUB,.CNT,28," ")
D SETTEXT("Applicable Color: ",CL,SUB,.CNT,28," ")
D SETTEXT("Applicable Image: ",IMG,SUB,.CNT,28," ")
D SETTEXT("Display On Not Applicable: ",$S($P(NODE,U)>0:"True",1:"False"),SUB,.CNT,28," ")
;
;Action Values
S NODE=$G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,30))
S TMP=$P($G(^ORI(101.73,$P(NODE,U),0)),U)
S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
D SETTEXT("Action ",TMP,SUB,.CNT,28," ")
S TMP=$P(NODE,U,2) D SETTEXT("Form Type: ",$S(TMP["Emb":"Embedded",TMP["Non":"Non Modal",TMP["Mod":"Modal",1:"Unknown"),SUB,.CNT,28," ")
I $P(NODE,U,3)>0 S TMP=$P($G(^OR(101.75,$P(NODE,U),0)),U) D SETTEXT("Detail Code: ",TMP,SUB,.CNT,28," ")
I $P(NODE,U,5)>0 S TMP=$P($G(^ORE(101.74,+$P(NODE,U,5),0)),U) D SETTEXT("Editor: ",TMP,SUB,.CNT,28," ")
D SETTEXT("Call Detail RPC: ",$P(NODE,U,4),SUB,.CNT,28," ")
;
K TEXTIN
S IDX=0,NUM=0 F S IDX=$O(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DTXT",IDX)) Q:IDX'>0 D
.S TEXTIN(IDX)=^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DTXT",IDX,0),NUM=NUM+1
D FORMATLONGTEXT("Detail Text: ",.TEXTIN,NUM,28,42," ",SUB,.CNT)
;
K TEXTIN S TEXTIN(1)=$P($G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"URL")),U)
D FORMATLONGTEXT("URL: ",.TEXTIN,1,28,42," ",SUB,.CNT)
;
S RIDX=0 F S RIDX=$O(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX)) Q:RIDX'>0 D
.S NODE=$G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX,0))
.S RIEN=+$P(NODE,U)
.S TMP=$P($G(^ORI(101.73,RIEN,0)),U)
.S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
.D SETTEXT("Required Data: ",TMP,SUB,.CNT,28," ")
.D SETTEXT("Required: ",$S($P(NODE,U,2)>0:"True",1:"False"),SUB,.CNT,28," ")
.K TEXTIN S TEXTIN(1)=$P($G(^ORI(101.73,RIEN,30)),U) D FORMATLONGTEXT("Error Message: ",.TEXTIN,1,28,42," ",SUB,.CNT)
.S IDX=0 F S IDX=$O(^ORI(101.73,RIEN,40,IDX)) Q:IDX'>0 D
..S NODE=$G(^ORI(101.73,RIEN,40,IDX,0))
..I IDX>1 S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
..D SETTEXT("Property Name: ",$P(NODE,U,1),SUB,.CNT,28," ")
..D SETTEXT("Required ",$S($P(NODE,U,2)="Y":"Yes",$P(NODE,U,2)="O":"Or",1:"No"),SUB,.CNT,28," ")
Q
;
INQSECTION(TIDX,PIDX,SIDX,SUB,CNT) ;
N CL,END,FILL,HEAD,IIDX,ISEQ,IMG,NAME,NODE,TEXTIN,TMP,X
S NODE=$G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,0))
S NAME=$P($G(^ORI(101.73,$P(NODE,U,2),0)),U)
D SETTEXT("Name: ",NAME,SUB,.CNT,20," ")
D SETTEXT("Disabled: ",$S($P(NODE,U,6)="true":"DISABLED",$P(NODE,U,6)="false":"ENABLED",1:""),SUB,.CNT,20," ")
K TEXTIN
S TEXTIN(1)=$P(NODE,U,3) D FORMATLONGTEXT("Display Text: ",.TEXTIN,1,20,50," ",SUB,.CNT)
D SETTEXT("Abbreviation: ",$P(NODE,U,4),SUB,.CNT,20," ")
S CL=$S(+$P(NODE,U,5)>0:$P($G(^ORI(101.73,$P(NODE,U,5),0)),U),1:"")
S IMG=$S(+$P(NODE,U,8)>0:$P($G(^ORI(101.73,$P(NODE,U,8),0)),U),1:"")
D SETTEXT("Color: ",CL,SUB,.CNT,20," ")
D SETTEXT("Image: ",IMG,SUB,.CNT,20," ")
S ISEQ=0
F S ISEQ=$O(^ORI(101.71,1,"PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ)) Q:ISEQ'>0 D
.S IIDX=$O(^ORI(101.71,1,"PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ,"")) Q:IIDX'>0
.S NODE=$G(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,0))
.;Default values for information item
.S NAME=$P(NODE,U,2)
.S HEAD="-- Begin Item Sequence: "_ISEQ_" -"
.S TMP=70-$L(HEAD) F X=1:1:TMP S HEAD=HEAD_"-"
.S CNT=CNT+1,^TMP(SUB,$J,CNT)=" "
.D SETTEXT(HEAD,"",SUB,.CNT,70," ")
.D INQITEM(TIDX,PIDX,SIDX,IIDX,SUB,.CNT)
.S END="-- End Item Sequence: "_ISEQ_" -"
.S TMP=70-$L(END) F X=1:1:TMP S END=END_"-"
.D SETTEXT(END,"",SUB,.CNT,70," ")
Q
;
SETTEXT(LBL,VALUE,SUB,CNT,RM,PAD) ;
S CNT=CNT+1
S ^TMP(SUB,$J,CNT)=$$RJ^XLFSTR(LBL,RM,PAD)_VALUE
Q
;
PROMPTITEM(TIDX,PKGIDX,SECIDX,ARGS,SCREEN) ;
N DIC,Y
S DIC="^ORI(101.71,"_TIDX_",""PKG"","_PKGIDX_",""LOC"","_SECIDX_",""ITM"","
S DIC(0)=ARGS
S DIC("A")="Select item sequence: "
I $G(SCREEN)'="" S DIC("S")=SCREEN
S DIC("?")=$S(ARGS["L":"Select an existing item or add a new item",1:"Select an existing item")
S DIC("??")="^D HELP^ORIHELP(6)"
D ^DIC
Q Y
;
PROMPTSECTION(TIDX,PKGIDX,ARGS,SCREEN) ;
N DIC,Y
S DIC="^ORI(101.71,"_TIDX_",""PKG"","_PKGIDX_",""LOC"","
S DIC(0)=ARGS
S DIC("A")="Select section sequence: "
I $G(SCREEN)'="" S DIC("S")=SCREEN
S DIC("?")=$S(ARGS["L":"Select an existing section or add a new section",1:"Select an existing section")
S DIC("??")="^D HELP^ORIHELP(5)"
D ^DIC
Q Y
;
SHOWITEMS(IARRAY,SECIDX) ;
N IDX,SCNT
W !,"Section Information Items"
W !,$$LJ^XLFSTR("Seq:",5)_$$LJ^XLFSTR("Name:",65)_"num#"
S SCNT=+$G(IARRAY("sectionIdSequence",SECIDX)) Q:SCNT'>0
S IDX=0 F S IDX=$O(IARRAY("sections",SCNT,"items",IDX)) Q:IDX'>0 D
.W !,$$LJ^XLFSTR(IARRAY("sections",SCNT,"items",IDX,"seq"),5)_$$LJ^XLFSTR(IARRAY("sections",SCNT,"items",IDX,"name"),65)_IARRAY("sections",SCNT,"items",IDX,"id")
Q
;
SHOWSECTIONS(IARRAY) ;
N IDX,SEQ
W !,"Information Sections:"
W !,$$LJ^XLFSTR("Seq:",5)_$$LJ^XLFSTR("Name:",65)_"Num#"
S SEQ=0 F S SEQ=$O(IARRAY("sectionSequence",SEQ)) Q:SEQ'>0 D
.S IDX=IARRAY("sectionSequence",SEQ)
.W !,$$LJ^XLFSTR(IARRAY("sections",IDX,"seq"),5)_$$LJ^XLFSTR(IARRAY("sections",IDX,"name"),65)_IARRAY("sections",IDX,"id")
Q
;
YESNO(PROMPT,HELP) ;
N DIR,DIROUT,DIRUT,DUOUT,DTOUT,Y
S DIR("A")=PROMPT
S DIR(0)="Y^"
S DIR("??")="^D HELP^ORIHELP("_HELP_")"
S DIR("?")="Select Yes to view everything. Select No to view a specific item."
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!($D(DIRUT)) Q -1
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORIMGR 13659 printed May 25, 2026@12:35:04 Page 2
ORIMGR ; SLC/AGP - Information panel VISTA manager ;Jun 11, 2025@08:21:33
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**508**;Dec 17, 1997;Build 39
+2 ;
+3 ; Reference to FORMAT^PXRMTEXT supported by DBIA # 6935
+4 ;
+5 QUIT
+6 ;
BLDIARRAY(TIDX,PKGIDX,IARRAY) ;
+1 NEW CNT,NODE,PCNT,PIDX,PSEQ,SCNT,SSEQ,SIDX
+2 KILL IARRAY
+3 SET SSEQ=0
SET SCNT=0
SET CNT=0
+4 FOR
SET SSEQ=$ORDER(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC","B",SSEQ))
if SSEQ'>0
QUIT
Begin DoDot:1
+5 SET SIDX=0
+6 FOR
SET SIDX=$ORDER(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC","B",SSEQ,SIDX))
if SIDX'>0
QUIT
Begin DoDot:2
+7 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,0))
SET SCNT=SCNT+1
+8 SET IARRAY("sections",SCNT,"id")=SIDX
SET IARRAY("sections",SCNT,"name")=$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,2),0)),U)
+9 SET IARRAY("sections",SCNT,"seq")=SSEQ
+10 SET IARRAY("sectionSequence",SSEQ)=SCNT
+11 SET IARRAY("sectionIdSequence",SIDX)=SCNT
+12 SET PSEQ=0
SET PCNT=0
+13 FOR
SET PSEQ=$ORDER(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,"ITM","B",PSEQ))
if PSEQ'>0
QUIT
Begin DoDot:3
+14 SET PIDX=0
+15 FOR
SET PIDX=$ORDER(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,"ITM","B",PSEQ,PIDX))
if PIDX'>0
QUIT
Begin DoDot:4
+16 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,"ITM",PIDX,0))
+17 SET PCNT=PCNT+1
+18 SET IARRAY("sections",SCNT,"items",PCNT,"id")=PIDX
+19 SET IARRAY("sections",SCNT,"items",PCNT,"name")=$PIECE(NODE,U,2)
+20 SET IARRAY("sections",SCNT,"items",PCNT,"seq")=PSEQ
+21 SET IARRAY("sectionSequence",SSEQ,"itemSequence",PSEQ)=PCNT
+22 SET IARRAY("itemSequence","section",SSEQ)=SCNT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
FINDBYNAME(FILE,PROMPT,SCREEN,DICZERO,DLAYGO) ;
+1 NEW DIC,DTOUT,DUOUT,Y
+2 SET DIC=FILE
+3 IF SCREEN'=""
SET DIC("S")=SCREEN
+4 SET DIC("A")=PROMPT
+5 SET DIC(0)=$SELECT($GET(DICZERO)'="":DICZERO,1:"AEMQ")
+6 DO ^DIC
+7 IF ($DATA(DTOUT))
SET Y=U
+8 IF ($DATA(DUOUT))
SET Y="^^"
+9 QUIT Y
+10 ;
FORMATLONGTEXT(LABEL,TEXTIN,NUM,LM,RM,PAD,SUB,CNT) ;
+1 ;use for inquiry, build word-processing fields to be used later
+2 ;because of DIWP API
+3 ;
+4 NEW IDX,NBL,NLINES,TEXTOUT,TMP
+5 IF RM<1
SET RM=50
+6 SET NBL=0
+7 SET TMP=$$RJ^XLFSTR(LABEL,LM,PAD)
IF NUM=0
SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=TMP
QUIT
+8 DO FORMAT^PXRMTEXT(0,RM,NUM,.TEXTIN,.NLINES,.TEXTOUT)
+9 FOR IDX=1:1:NLINES
Begin DoDot:1
+10 IF IDX=1
SET TMP=TMP_TEXTOUT(IDX)
DO SETTEXT(TMP,"",SUB,.CNT,LM,PAD)
QUIT
+11 SET TMP=$$RJ^XLFSTR(" ",LM,PAD)_TEXTOUT(IDX)
SET NBL=1
DO SETTEXT(TMP,"",SUB,.CNT,LM,PAD)
End DoDot:1
+12 IF NBL=1
SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
+13 QUIT
+14 ;
+1 NEW TEMP,TEXTLEN,TEXTUND
+2 SET TEXTUND=$TRANSLATE($JUSTIFY("",IOM)," ","-")
+3 SET TEMP=$$NOW^XLFDT_" Page "_DC
+4 SET TEXTLEN=$LENGTH(TEMP)
+5 WRITE TEXT
+6 WRITE ?(IOM-TEXTLEN),TEMP
+7 WRITE !,TEXTUND,!!
+8 QUIT
+9 ;
INQ(DIC,DA,FLDS,HTEXT) ;
+1 NEW BY,CNT,DC,DHD,FR,IDX,L,NOW,TO
+2 SET L=0
+3 SET BY="NUMBER"
+4 SET (FR,TO)=+DA
+5 IF $LENGTH(HTEXT)>0
Begin DoDot:1
+6 SET NOW=$$NOW^XLFDT
+7 SET NOW=$$FMTE^XLFDT(NOW,"1P")
+8 SET DHD="W ?0 D HEADER^ORIMGR("""_HTEXT_""")"
End DoDot:1
+9 IF '$TEST
SET DHD="@@"
+10 DO EN1^DIP
+11 QUIT
+12 ;
INQPANEL ;
+1 NEW CNT,DIWF,DIWL,END,FILL,HEAD,NAME,NODE,SECSEQ,SIDX,SUB,X
+2 SET DIWF="C80N"
SET DIWL=2
SET CNT=0
+3 SET SUB="ORIMGR INQPANEL"
KILL ^TMP(SUB,$JOB)
+4 SET SECSEQ=0
+5 FOR
SET SECSEQ=$ORDER(^ORI(101.71,D1,"PKG",D0,"LOC","B",SECSEQ))
if SECSEQ'>0
QUIT
Begin DoDot:1
+6 SET SIDX=$ORDER(^ORI(101.71,D1,"PKG",D0,"LOC","B",SECSEQ,""))
if SIDX'>0
QUIT
+7 SET NODE=$GET(^ORI(101.71,D1,"PKG",D0,"LOC",SIDX,0))
+8 SET NAME=$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,2),0)),U)
+9 SET HEAD="--- Begin Section Sequence: "_SECSEQ_" -"
+10 SET FILL=75-$LENGTH(HEAD)
FOR X=1:1:FILL
SET HEAD=HEAD_"-"
+11 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=$$RJ^XLFSTR(HEAD,75," ")
+12 DO INQSECTION(D1,D0,SIDX,SUB,.CNT)
+13 SET END="--- End Section Sequence: "_SECSEQ_" -"
+14 SET FILL=75-$LENGTH(END)
FOR X=1:1:FILL
SET END=END_"-"
+15 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=$$RJ^XLFSTR(END,75," ")
+16 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
End DoDot:1
+17 SET CNT=0
FOR
SET CNT=$ORDER(^TMP(SUB,$JOB,CNT))
if CNT'>0
QUIT
Begin DoDot:1
+18 SET X=^TMP(SUB,$JOB,CNT)
DO ^DIWP
End DoDot:1
+19 QUIT
+20 ;
OTHERFILES(FN) ;
+1 NEW ACT,DA,DIE,DIDEL,DINUSE,DR,FLDS,GBL,HEAD,PRMPT,ISNEW,NAME,PNAME,TNAME,Y
+2 SET GBL=$SELECT(FN=101.75:"^OR(101.75,",FN=101.73:"^ORI(101.73,",FN=101.74:"^ORE(101.74,",1:"")
IF GBL=""
QUIT
+3 SET PRMPT="Select "_$SELECT(FN=101.75:"plugin: ",FN=101.73:"component: ",1:"editor: ")
+4 SET TNAME=$SELECT(FN=101.75:"[OR EDIT M PLUGIN]",FN=101.73:"[ORI EDIT COMPONENT]",1:"[ORE EDIT EDITOR]")
+5 SET PNAME=$SELECT(FN=101.75:"[OR PRINT M PLUGIN]",FN=101.73:"[ORI PRINT COMPONENT]",1:"[ORE PRINT EDITOR]")
+6 SET HEAD=$SELECT(FN=101.75:"OR PRINT M PLUGIN",FN=101.73:"ORI PRINT COMPONENT",1:"ORE PRINT EDITOR")
+7 SET DA=$$FINDBYNAME(GBL,PRMPT,"",$SELECT($GET(ORIMGR)=1:"AELMQ",1:"AEMQ"),FN)
+8 IF +DA'>0
QUIT
+9 SET NAME=$PIECE(DA,U,2)
SET ISNEW=$PIECE(DA,U,3)
+10 SET DA=+DA
+11 DO INQ(GBL,DA,PNAME,HEAD)
+12 QUIT
+13 ;
PANELUI ;
+1 ;S ORIMGR=1
+2 NEW ASK,CNT,DA,DIWF,DIWL,IARRAY,NAME,PKG,PKGIDX,SIDX,SUB,TIDX,TMP
+3 SET TIDX=+$ORDER(^ORI(101.71,"B","NATIONAL",""))
IF TIDX=0
WRITE !,"Cannot find national panel entry."
QUIT
+4 SET PKG=$$LU^ORIRPC(9.4,"ORDER ENTRY/RESULTS REPORTING","X")
IF +PKG<1
WRITE !,"Could not find the ORDER ENTRY/RESULTS REPORTING package file entry."
QUIT
+5 SET PKGIDX=+$ORDER(^ORI(101.71,TIDX,"PKG","B",PKG,""))
IF PKGIDX=0
WRITE !,"Could not find the ORDER ENTRY/RESULTS REPORTING entry in the National entry."
QUIT
+6 DO BLDIARRAY(TIDX,PKGIDX,.IARRAY)
+7 SET DA(1)=TIDX
SET DA=PKGIDX
SET NAME=$PIECE($GET(^ORI(101.71,TIDX,0)),U)
+8 SET ASK=$$YESNO("View entire "_NAME_" entry",3)
IF +ASK<0
QUIT
+9 IF +ASK=1
DO INQ("^ORI(101.71,",.DA,"[ORI PANEL INQUIRY]","Information Panel Inquiry")
QUIT
+10 SET DIWF="C80N"
SET DIWL=2
+11 DO SHOWSECTIONS(.IARRAY)
+12 SET ASK=$$PROMPTSECTION(TIDX,PKGIDX,"QEA","")
IF +ASK<1
QUIT
+13 SET SIDX=+ASK
+14 SET TMP=$PIECE($GET(^ORI(101.73,$PIECE($GET(^ORI(101.71,TIDX,"PKG",PKGIDX,"LOC",SIDX,0)),U,2),0)),U)
+15 SET ASK=$$YESNO("View entire "_TMP_" entry",3)
IF +ASK<0
QUIT
+16 SET SUB="ORIMGR INQASK"
SET CNT=0
KILL ^TMP(SUB,$JOB)
+17 IF ASK=1
DO INQSECTION(TIDX,PKGIDX,SIDX,SUB,.CNT)
GOTO INQASKX
+18 DO SHOWITEMS(.IARRAY,SIDX)
+19 SET ASK=$$PROMPTITEM^ORIMGR(TIDX,PKGIDX,SIDX,"QEA","")
IF ASK<0
QUIT
+20 IF ASK>0
DO INQITEM(TIDX,PKGIDX,SIDX,+ASK,SUB,.CNT)
INQASKX ;
+1 WRITE !
+2 SET CNT=0
FOR
SET CNT=$ORDER(^TMP(SUB,$JOB,CNT))
if CNT'>0
QUIT
WRITE !,^TMP(SUB,$JOB,CNT)
+3 QUIT
INQITEM(TIDX,PIDX,SIDX,IIDX,SUB,CNT) ;
+1 NEW CDRPC,CL,EDITOR,END,ETYPE,FN,HEAD,IMG,NAME,NODE,NOTAPP,NUM,IDX,RIDX,RIEN,TEXTIN,TMP
+2 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,0))
+3 ;Default values for information item
+4 SET EDITOR=0
+5 SET NAME=$PIECE(NODE,U,2)
+6 DO SETTEXT("Name: ",NAME,SUB,.CNT,28," ")
+7 DO SETTEXT("Status: ",$SELECT($PIECE(NODE,U,3)="false":"DISABLED",$PIECE(NODE,U,3)="locked":"LOCKED FOR EDITING",1:"ENABLED"),SUB,.CNT,28," ")
+8 IF $PIECE(NODE,U,7)'=""
DO SETTEXT("Mandatory: ",$SELECT($PIECE(NODE,U,7)=1:"YES",1:"NO"),SUB,.CNT,28," ")
+9 KILL TEXTIN
+10 SET IDX=0
SET NUM=0
FOR
SET IDX=$ORDER(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DESC",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+11 SET TEXTIN(IDX)=^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DESC",IDX,0)
SET NUM=NUM+1
End DoDot:1
+12 DO FORMATLONGTEXT("Description: ",.TEXTIN,NUM,28,42," ",SUB,.CNT)
+13 KILL TEXTIN
+14 SET TEXTIN(1)=$PIECE(NODE,U,5)
+15 DO FORMATLONGTEXT("Display Text: ",.TEXTIN,1,28,42," ",SUB,.CNT)
+16 SET CL=$SELECT(+$PIECE(NODE,U,6)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,6),0)),U),1:"")
+17 SET IMG=$SELECT(+$PIECE(NODE,U,8)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,8),0)),U),1:"")
+18 DO SETTEXT("Abbreviation: ",$PIECE(NODE,U,4),SUB,.CNT,28," ")
+19 DO SETTEXT("Color: ",CL,SUB,.CNT,28," ")
+20 DO SETTEXT("Image: ",IMG,SUB,.CNT,28," ")
+21 ;
+22 ;Evaluation Items
+23 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
+24 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,10))
+25 SET ETYPE=$SELECT($PIECE(NODE,U)="C":"Code",$PIECE(NODE,U)="RD":"Reminder Definition",$PIECE(NODE,U)="RT":"Reminder Term",1:"None")
+26 DO SETTEXT("Evaluation Type: ",ETYPE,SUB,.CNT,28," ")
+27 IF ETYPE["R"
Begin DoDot:1
+28 SET TMP=$SELECT($PIECE(NODE,U,2)["PXRMD(811.5":"RT.",1:"RD.")
SET FN=+$PIECE($PIECE(NODE,U,2),"(",2)
+29 DO SETTEXT("Reminder Component: ",TMP_$$GET1^DIQ(FN,+$PIECE(NODE,U,2)_",",.01),SUB,.CNT,28," ")
+30 SET TMP=$PIECE(NODE,U,3)
DO SETTEXT("Reminder Status: ",$SELECT(TMP="T":"True",TMP="F":"False",TMP="D":"Due",TMP="A":"Applicable",TMP="N":"N/A",1:""),SUB,.CNT,28," ")
End DoDot:1
+31 IF $PIECE(NODE,U)="C"
IF +$PIECE(NODE,U,4)>0
SET TMP=$PIECE($GET(^OR(101.75,$PIECE(NODE,U,4),0)),U)
DO SETTEXT("Evaluation Code: ",TMP,SUB,.CNT,28," ")
+32 ;
+33 ;Applicable Values
+34 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,20))
+35 SET CL=$SELECT(+$PIECE(NODE,U,4)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,4),0)),U),1:"")
+36 SET IMG=$SELECT(+$PIECE(NODE,U,5)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,5),0)),U),1:"")
+37 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
+38 KILL TEXTIN
SET TEXTIN(1)=$PIECE(NODE,U,3)
+39 DO FORMATLONGTEXT("Applicable Display Text: ",.TEXTIN,1,28,42," ",SUB,.CNT)
+40 SET CL=$SELECT(+$PIECE(NODE,U,6)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,6),0)),U),1:"")
+41 SET IMG=$SELECT(+$PIECE(NODE,U,8)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,8),0)),U),1:"")
+42 DO SETTEXT("Applicable Abbreviation: ",$PIECE(NODE,U,4),SUB,.CNT,28," ")
+43 DO SETTEXT("Applicable Color: ",CL,SUB,.CNT,28," ")
+44 DO SETTEXT("Applicable Image: ",IMG,SUB,.CNT,28," ")
+45 DO SETTEXT("Display On Not Applicable: ",$SELECT($PIECE(NODE,U)>0:"True",1:"False"),SUB,.CNT,28," ")
+46 ;
+47 ;Action Values
+48 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,30))
+49 SET TMP=$PIECE($GET(^ORI(101.73,$PIECE(NODE,U),0)),U)
+50 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
+51 DO SETTEXT("Action ",TMP,SUB,.CNT,28," ")
+52 SET TMP=$PIECE(NODE,U,2)
DO SETTEXT("Form Type: ",$SELECT(TMP["Emb":"Embedded",TMP["Non":"Non Modal",TMP["Mod":"Modal",1:"Unknown"),SUB,.CNT,28," ")
+53 IF $PIECE(NODE,U,3)>0
SET TMP=$PIECE($GET(^OR(101.75,$PIECE(NODE,U),0)),U)
DO SETTEXT("Detail Code: ",TMP,SUB,.CNT,28," ")
+54 IF $PIECE(NODE,U,5)>0
SET TMP=$PIECE($GET(^ORE(101.74,+$PIECE(NODE,U,5),0)),U)
DO SETTEXT("Editor: ",TMP,SUB,.CNT,28," ")
+55 DO SETTEXT("Call Detail RPC: ",$PIECE(NODE,U,4),SUB,.CNT,28," ")
+56 ;
+57 KILL TEXTIN
+58 SET IDX=0
SET NUM=0
FOR
SET IDX=$ORDER(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DTXT",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+59 SET TEXTIN(IDX)=^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"DTXT",IDX,0)
SET NUM=NUM+1
End DoDot:1
+60 DO FORMATLONGTEXT("Detail Text: ",.TEXTIN,NUM,28,42," ",SUB,.CNT)
+61 ;
+62 KILL TEXTIN
SET TEXTIN(1)=$PIECE($GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"URL")),U)
+63 DO FORMATLONGTEXT("URL: ",.TEXTIN,1,28,42," ",SUB,.CNT)
+64 ;
+65 SET RIDX=0
FOR
SET RIDX=$ORDER(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX))
if RIDX'>0
QUIT
Begin DoDot:1
+66 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,"REQD",RIDX,0))
+67 SET RIEN=+$PIECE(NODE,U)
+68 SET TMP=$PIECE($GET(^ORI(101.73,RIEN,0)),U)
+69 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
+70 DO SETTEXT("Required Data: ",TMP,SUB,.CNT,28," ")
+71 DO SETTEXT("Required: ",$SELECT($PIECE(NODE,U,2)>0:"True",1:"False"),SUB,.CNT,28," ")
+72 KILL TEXTIN
SET TEXTIN(1)=$PIECE($GET(^ORI(101.73,RIEN,30)),U)
DO FORMATLONGTEXT("Error Message: ",.TEXTIN,1,28,42," ",SUB,.CNT)
+73 SET IDX=0
FOR
SET IDX=$ORDER(^ORI(101.73,RIEN,40,IDX))
if IDX'>0
QUIT
Begin DoDot:2
+74 SET NODE=$GET(^ORI(101.73,RIEN,40,IDX,0))
+75 IF IDX>1
SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
+76 DO SETTEXT("Property Name: ",$PIECE(NODE,U,1),SUB,.CNT,28," ")
+77 DO SETTEXT("Required ",$SELECT($PIECE(NODE,U,2)="Y":"Yes",$PIECE(NODE,U,2)="O":"Or",1:"No"),SUB,.CNT,28," ")
End DoDot:2
End DoDot:1
+78 QUIT
+79 ;
INQSECTION(TIDX,PIDX,SIDX,SUB,CNT) ;
+1 NEW CL,END,FILL,HEAD,IIDX,ISEQ,IMG,NAME,NODE,TEXTIN,TMP,X
+2 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,0))
+3 SET NAME=$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,2),0)),U)
+4 DO SETTEXT("Name: ",NAME,SUB,.CNT,20," ")
+5 DO SETTEXT("Disabled: ",$SELECT($PIECE(NODE,U,6)="true":"DISABLED",$PIECE(NODE,U,6)="false":"ENABLED",1:""),SUB,.CNT,20," ")
+6 KILL TEXTIN
+7 SET TEXTIN(1)=$PIECE(NODE,U,3)
DO FORMATLONGTEXT("Display Text: ",.TEXTIN,1,20,50," ",SUB,.CNT)
+8 DO SETTEXT("Abbreviation: ",$PIECE(NODE,U,4),SUB,.CNT,20," ")
+9 SET CL=$SELECT(+$PIECE(NODE,U,5)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,5),0)),U),1:"")
+10 SET IMG=$SELECT(+$PIECE(NODE,U,8)>0:$PIECE($GET(^ORI(101.73,$PIECE(NODE,U,8),0)),U),1:"")
+11 DO SETTEXT("Color: ",CL,SUB,.CNT,20," ")
+12 DO SETTEXT("Image: ",IMG,SUB,.CNT,20," ")
+13 SET ISEQ=0
+14 FOR
SET ISEQ=$ORDER(^ORI(101.71,1,"PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ))
if ISEQ'>0
QUIT
Begin DoDot:1
+15 SET IIDX=$ORDER(^ORI(101.71,1,"PKG",PIDX,"LOC",SIDX,"ITM","B",ISEQ,""))
if IIDX'>0
QUIT
+16 SET NODE=$GET(^ORI(101.71,TIDX,"PKG",PIDX,"LOC",SIDX,"ITM",IIDX,0))
+17 ;Default values for information item
+18 SET NAME=$PIECE(NODE,U,2)
+19 SET HEAD="-- Begin Item Sequence: "_ISEQ_" -"
+20 SET TMP=70-$LENGTH(HEAD)
FOR X=1:1:TMP
SET HEAD=HEAD_"-"
+21 SET CNT=CNT+1
SET ^TMP(SUB,$JOB,CNT)=" "
+22 DO SETTEXT(HEAD,"",SUB,.CNT,70," ")
+23 DO INQITEM(TIDX,PIDX,SIDX,IIDX,SUB,.CNT)
+24 SET END="-- End Item Sequence: "_ISEQ_" -"
+25 SET TMP=70-$LENGTH(END)
FOR X=1:1:TMP
SET END=END_"-"
+26 DO SETTEXT(END,"",SUB,.CNT,70," ")
End DoDot:1
+27 QUIT
+28 ;
SETTEXT(LBL,VALUE,SUB,CNT,RM,PAD) ;
+1 SET CNT=CNT+1
+2 SET ^TMP(SUB,$JOB,CNT)=$$RJ^XLFSTR(LBL,RM,PAD)_VALUE
+3 QUIT
+4 ;
PROMPTITEM(TIDX,PKGIDX,SECIDX,ARGS,SCREEN) ;
+1 NEW DIC,Y
+2 SET DIC="^ORI(101.71,"_TIDX_",""PKG"","_PKGIDX_",""LOC"","_SECIDX_",""ITM"","
+3 SET DIC(0)=ARGS
+4 SET DIC("A")="Select item sequence: "
+5 IF $GET(SCREEN)'=""
SET DIC("S")=SCREEN
+6 SET DIC("?")=$SELECT(ARGS["L":"Select an existing item or add a new item",1:"Select an existing item")
+7 SET DIC("??")="^D HELP^ORIHELP(6)"
+8 DO ^DIC
+9 QUIT Y
+10 ;
PROMPTSECTION(TIDX,PKGIDX,ARGS,SCREEN) ;
+1 NEW DIC,Y
+2 SET DIC="^ORI(101.71,"_TIDX_",""PKG"","_PKGIDX_",""LOC"","
+3 SET DIC(0)=ARGS
+4 SET DIC("A")="Select section sequence: "
+5 IF $GET(SCREEN)'=""
SET DIC("S")=SCREEN
+6 SET DIC("?")=$SELECT(ARGS["L":"Select an existing section or add a new section",1:"Select an existing section")
+7 SET DIC("??")="^D HELP^ORIHELP(5)"
+8 DO ^DIC
+9 QUIT Y
+10 ;
SHOWITEMS(IARRAY,SECIDX) ;
+1 NEW IDX,SCNT
+2 WRITE !,"Section Information Items"
+3 WRITE !,$$LJ^XLFSTR("Seq:",5)_$$LJ^XLFSTR("Name:",65)_"num#"
+4 SET SCNT=+$GET(IARRAY("sectionIdSequence",SECIDX))
if SCNT'>0
QUIT
+5 SET IDX=0
FOR
SET IDX=$ORDER(IARRAY("sections",SCNT,"items",IDX))
if IDX'>0
QUIT
Begin DoDot:1
+6 WRITE !,$$LJ^XLFSTR(IARRAY("sections",SCNT,"items",IDX,"seq"),5)_$$LJ^XLFSTR(IARRAY("sections",SCNT,"items",IDX,"name"),65)_IARRAY("sections",SCNT,"items",IDX,"id")
End DoDot:1
+7 QUIT
+8 ;
SHOWSECTIONS(IARRAY) ;
+1 NEW IDX,SEQ
+2 WRITE !,"Information Sections:"
+3 WRITE !,$$LJ^XLFSTR("Seq:",5)_$$LJ^XLFSTR("Name:",65)_"Num#"
+4 SET SEQ=0
FOR
SET SEQ=$ORDER(IARRAY("sectionSequence",SEQ))
if SEQ'>0
QUIT
Begin DoDot:1
+5 SET IDX=IARRAY("sectionSequence",SEQ)
+6 WRITE !,$$LJ^XLFSTR(IARRAY("sections",IDX,"seq"),5)_$$LJ^XLFSTR(IARRAY("sections",IDX,"name"),65)_IARRAY("sections",IDX,"id")
End DoDot:1
+7 QUIT
+8 ;
YESNO(PROMPT,HELP) ;
+1 NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,Y
+2 SET DIR("A")=PROMPT
+3 SET DIR(0)="Y^"
+4 SET DIR("??")="^D HELP^ORIHELP("_HELP_")"
+5 SET DIR("?")="Select Yes to view everything. Select No to view a specific item."
+6 DO ^DIR
+7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!($DATA(DIRUT))
QUIT -1
+8 QUIT Y
+9 ;
