PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;08/25/2017
;;2.0;CLINICAL REMINDERS;**4,6,12,26,42**;Feb 04, 2005;Build 245
;======================================================
BLDLIST(FORCE) ;Build a list of all repository entries.
;If FORCE is true then force rebuilding of the list.
I FORCE K ^TMP("PXRMEXLR",$J)
I $D(^TMP("PXRMEXLR",$J,"VALMCNT")) S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT")
E D
. D REXL^PXRMLIST("PXRMEXLR")
. S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT")
Q
;
;======================================================
CDISP(IEN) ;Format component list for display.
N CAT,CLOK,CMPNT,END,EXISTS,FILENUM,FMTSTR,FOKTT,IOKTI,IND,INDEX
N JND,JNDS,KND,MSG,NCMPNT,NDLINE,NITEMS,NLINE,NSEL,PT01
N START,TEMP,TEMP0,TYPE
K ^TMP("PXRMEXLC",$J),^TMP("PXRMEXLD",$J)
S CLOK=1
I ('$D(^PXD(811.8,IEN,119)))!('$D(^PXD(811.8,IEN,120))) D CLIST^PXRMEXCO(IEN,.CLOK)
I 'CLOK Q
;If this is being called by the Silent Installer VALMDDF will not
;exist.
S FMTSTR=$S('$D(VALMDDF):"4R2^50L4^8C5^6C",1:$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLCC"))
S (NDLINE,NLINE,NSEL)=0
;Load the description.
F IND=1:1:$P(^PXD(811.8,IEN,110,0),U,4) D
. S NLINE=NLINE+1
. S ^TMP("PXRMEXLC",$J,NLINE,0)=^PXD(811.8,IEN,110,IND,0)
S NLINE=NLINE+1
S ^TMP("PXRMEXLC",$J,NLINE,0)=" "
S NCMPNT=^PXD(811.8,IEN,119)
;Load the text for display.
;Build and load the item selection list for display.
F IND=1:1:NCMPNT D
. S NLINE=NLINE+1
. S TEMP=^PXD(811.8,IEN,120,IND,0)
. S ^TMP("PXRMEXLC",$J,NLINE,0)=$P(TEMP,U,1)
. S FILENUM=$P(TEMP,U,2)
. S NITEMS=$P(TEMP,U,3)
.;See if items in this file are ok to transport.
. S FOKTT=$$FOKTT^PXRMEXFI(FILENUM)
. F JND=1:1:NITEMS D
.. S TEMP=^PXD(811.8,IEN,120,IND,1,JND,0)
..;If items from this file can be installed make sure the individual
..;item is installable.
.. S IOKTI=$S('FOKTT:0,1:$$IOKTI^PXRMEXFI(IEN,FILENUM,TEMP))
.. S PT01=$P(TEMP,U,1)
.. S EXISTS=$S(FILENUM=0:$$EXISTS^PXRMEXCF(PT01),1:$$EXISTS^PXRMEXIU(FILENUM,PT01,"W"))
..;If this is a health factor see if it is a category.
.. S CAT=""
.. I (FILENUM=9999999.64) D
... S TYPE=""
... S START=$P(TEMP,U,2)
... S END=$P(TEMP,U,3)
... F KND=START:1:END D
.... S TEMP0=$P(^PXD(811.8,IEN,100,KND,0),";",3)
.... I $P(TEMP0,"~",1)=.1 S TYPE=$P(TEMP0,"~",2)
... I TYPE="CATEGORY" S CAT="X"
..;If entries in this file are ok to install add them to the
..;selectable list. For dialog items only display those that are
..;selectable.
.. I FILENUM=801.41,'IOKTI Q
.. I IOKTI D
... S NSEL=NSEL+1,INDEX=NSEL
... S ^TMP("PXRMEXLC",$J,"SEL",NSEL)=FILENUM_U_IND_U_JND_U_EXISTS
... S ^TMP("PXRMEXLC",$J,"IDX",NSEL,NSEL)=""
.. E S INDEX=""
.. D FMTDATA(FMTSTR,INDEX,PT01,CAT,EXISTS,.NLINE)
. S NLINE=NLINE+1
. S ^TMP("PXRMEXLC",$J,NLINE,0)=""
Q
;
;======================================================
FMTDATA(FMTSTR,NSEL,PT01,CAT,EXISTS,NLINE) ;Format items for display.
N IND,NL,NSTI,OUTPUT,TEMP
S TEMP=NSEL_U_PT01_U_CAT_U_$S(EXISTS:"X",1:"")
D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
F IND=1:1:NL S NLINE=NLINE+1,^TMP("PXRMEXLC",$J,NLINE,0)=OUTPUT(IND)
Q
;
;======================================================
INSCHR(NUM,CHR) ;Return a string of NUM characters (CHR).
N TEMP
I NUM<1 Q ""
S TEMP="",$P(TEMP,CHR,NUM+1)=""
Q TEMP
;
;======================================================
ORDER(STRING,ORDER) ;Rebuild string in ascending or descending order.
N ARRAY,ITEM,CNT
F CNT=1:1 S ITEM=$P(STRING,",",CNT) Q:'ITEM S ARRAY(ITEM)=""
K STRING
F CNT=1:1 S ITEM=$O(ARRAY(ITEM),ORDER) Q:'ITEM S $P(STRING,",",CNT)=ITEM
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXLC 3687 printed Dec 13, 2024@01:45:03 Page 2
PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;08/25/2017
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,26,42**;Feb 04, 2005;Build 245
+2 ;======================================================
BLDLIST(FORCE) ;Build a list of all repository entries.
+1 ;If FORCE is true then force rebuilding of the list.
+2 IF FORCE
KILL ^TMP("PXRMEXLR",$JOB)
+3 IF $DATA(^TMP("PXRMEXLR",$JOB,"VALMCNT"))
SET VALMCNT=^TMP("PXRMEXLR",$JOB,"VALMCNT")
+4 IF '$TEST
Begin DoDot:1
+5 DO REXL^PXRMLIST("PXRMEXLR")
+6 SET VALMCNT=^TMP("PXRMEXLR",$JOB,"VALMCNT")
End DoDot:1
+7 QUIT
+8 ;
+9 ;======================================================
CDISP(IEN) ;Format component list for display.
+1 NEW CAT,CLOK,CMPNT,END,EXISTS,FILENUM,FMTSTR,FOKTT,IOKTI,IND,INDEX
+2 NEW JND,JNDS,KND,MSG,NCMPNT,NDLINE,NITEMS,NLINE,NSEL,PT01
+3 NEW START,TEMP,TEMP0,TYPE
+4 KILL ^TMP("PXRMEXLC",$JOB),^TMP("PXRMEXLD",$JOB)
+5 SET CLOK=1
+6 IF ('$DATA(^PXD(811.8,IEN,119)))!('$DATA(^PXD(811.8,IEN,120)))
DO CLIST^PXRMEXCO(IEN,.CLOK)
+7 IF 'CLOK
QUIT
+8 ;If this is being called by the Silent Installer VALMDDF will not
+9 ;exist.
+10 SET FMTSTR=$SELECT('$DATA(VALMDDF):"4R2^50L4^8C5^6C",1:$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLCC"))
+11 SET (NDLINE,NLINE,NSEL)=0
+12 ;Load the description.
+13 FOR IND=1:1:$PIECE(^PXD(811.8,IEN,110,0),U,4)
Begin DoDot:1
+14 SET NLINE=NLINE+1
+15 SET ^TMP("PXRMEXLC",$JOB,NLINE,0)=^PXD(811.8,IEN,110,IND,0)
End DoDot:1
+16 SET NLINE=NLINE+1
+17 SET ^TMP("PXRMEXLC",$JOB,NLINE,0)=" "
+18 SET NCMPNT=^PXD(811.8,IEN,119)
+19 ;Load the text for display.
+20 ;Build and load the item selection list for display.
+21 FOR IND=1:1:NCMPNT
Begin DoDot:1
+22 SET NLINE=NLINE+1
+23 SET TEMP=^PXD(811.8,IEN,120,IND,0)
+24 SET ^TMP("PXRMEXLC",$JOB,NLINE,0)=$PIECE(TEMP,U,1)
+25 SET FILENUM=$PIECE(TEMP,U,2)
+26 SET NITEMS=$PIECE(TEMP,U,3)
+27 ;See if items in this file are ok to transport.
+28 SET FOKTT=$$FOKTT^PXRMEXFI(FILENUM)
+29 FOR JND=1:1:NITEMS
Begin DoDot:2
+30 SET TEMP=^PXD(811.8,IEN,120,IND,1,JND,0)
+31 ;If items from this file can be installed make sure the individual
+32 ;item is installable.
+33 SET IOKTI=$SELECT('FOKTT:0,1:$$IOKTI^PXRMEXFI(IEN,FILENUM,TEMP))
+34 SET PT01=$PIECE(TEMP,U,1)
+35 SET EXISTS=$SELECT(FILENUM=0:$$EXISTS^PXRMEXCF(PT01),1:$$EXISTS^PXRMEXIU(FILENUM,PT01,"W"))
+36 ;If this is a health factor see if it is a category.
+37 SET CAT=""
+38 IF (FILENUM=9999999.64)
Begin DoDot:3
+39 SET TYPE=""
+40 SET START=$PIECE(TEMP,U,2)
+41 SET END=$PIECE(TEMP,U,3)
+42 FOR KND=START:1:END
Begin DoDot:4
+43 SET TEMP0=$PIECE(^PXD(811.8,IEN,100,KND,0),";",3)
+44 IF $PIECE(TEMP0,"~",1)=.1
SET TYPE=$PIECE(TEMP0,"~",2)
End DoDot:4
+45 IF TYPE="CATEGORY"
SET CAT="X"
End DoDot:3
+46 ;If entries in this file are ok to install add them to the
+47 ;selectable list. For dialog items only display those that are
+48 ;selectable.
+49 IF FILENUM=801.41
IF 'IOKTI
QUIT
+50 IF IOKTI
Begin DoDot:3
+51 SET NSEL=NSEL+1
SET INDEX=NSEL
+52 SET ^TMP("PXRMEXLC",$JOB,"SEL",NSEL)=FILENUM_U_IND_U_JND_U_EXISTS
+53 SET ^TMP("PXRMEXLC",$JOB,"IDX",NSEL,NSEL)=""
End DoDot:3
+54 IF '$TEST
SET INDEX=""
+55 DO FMTDATA(FMTSTR,INDEX,PT01,CAT,EXISTS,.NLINE)
End DoDot:2
+56 SET NLINE=NLINE+1
+57 SET ^TMP("PXRMEXLC",$JOB,NLINE,0)=""
End DoDot:1
+58 QUIT
+59 ;
+60 ;======================================================
FMTDATA(FMTSTR,NSEL,PT01,CAT,EXISTS,NLINE) ;Format items for display.
+1 NEW IND,NL,NSTI,OUTPUT,TEMP
+2 SET TEMP=NSEL_U_PT01_U_CAT_U_$SELECT(EXISTS:"X",1:"")
+3 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
+4 FOR IND=1:1:NL
SET NLINE=NLINE+1
SET ^TMP("PXRMEXLC",$JOB,NLINE,0)=OUTPUT(IND)
+5 QUIT
+6 ;
+7 ;======================================================
INSCHR(NUM,CHR) ;Return a string of NUM characters (CHR).
+1 NEW TEMP
+2 IF NUM<1
QUIT ""
+3 SET TEMP=""
SET $PIECE(TEMP,CHR,NUM+1)=""
+4 QUIT TEMP
+5 ;
+6 ;======================================================
ORDER(STRING,ORDER) ;Rebuild string in ascending or descending order.
+1 NEW ARRAY,ITEM,CNT
+2 FOR CNT=1:1
SET ITEM=$PIECE(STRING,",",CNT)
if 'ITEM
QUIT
SET ARRAY(ITEM)=""
+3 KILL STRING
+4 FOR CNT=1:1
SET ITEM=$ORDER(ARRAY(ITEM),ORDER)
if 'ITEM
QUIT
SET $PIECE(STRING,",",CNT)=ITEM
+5 QUIT
+6 ;
