- PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;08/01/2013
- ;;2.0;CLINICAL REMINDERS;**4,6,12,26**;Feb 04, 2005;Build 404
- ;======================================================
- 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 IND,TEMP
- S TEMP=""
- I NUM<1 Q TEMP
- F IND=1:1:NUM S TEMP=TEMP_CHR
- 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
- ;
- PXRMEXLC ; SLC/PKR/PJH - Routines to display repository entry components. ;08/01/2013
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12,26**;Feb 04, 2005;Build 404
- +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 IND,TEMP
- +2 SET TEMP=""
- +3 IF NUM<1
- QUIT TEMP
- +4 FOR IND=1:1:NUM
- SET TEMP=TEMP_CHR
- +5 QUIT TEMP
- +6 ;
- +7 ;======================================================
- 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 ;