PXRMLIST ; SLC/PKR/PJH - Clinical Reminders list functions. ;01/18/2013
;;2.0;CLINICAL REMINDERS;**6,26**;Feb 04, 2005;Build 404
;Used in the reminder exchange utility for building lists of
;reminders, Exchange File entries, etc.
;=======================================================
FRDEF(NAME,PNAME) ;Format the reminder name and print name.
N IND,TEMP
S TEMP=$$LJ^XLFSTR(NAME,40," ")
S TEMP=TEMP_PNAME
Q TEMP
;
;=======================================================
FMT(NUMBER,NAME,SOURCE,DATE,FMTSTR,NL,OUTPUT) ;Format entry number, name,
;source, and date packed for LM display.
N TEMP,TSOURCE
S TEMP=NUMBER_U_NAME
S TSOURCE=$E($P(SOURCE,",",1),1,12)_"@"_$E($P(SOURCE," at ",2),1,12)
S TEMP=TEMP_U_TSOURCE
S DATE=$$FMTE^XLFDT(DATE,"5Z")
S TEMP=TEMP_U_DATE
D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
Q
;
;=======================================================
LIST ;Print a list of location lists.
N BY,DIC,FLDS,FR,L,PXRMEDOK
S PXRMEDOK=1
S BY=".01"
S DIC="^PXRMD(810.9,"
S FLDS="[PXRM LOCATION LIST LIST]"
S FR=""
S L=0
D EN1^DIP
Q
;
;=======================================================
MRKINACT(TEXT) ;Append the inactive mark to TEXT in column 77.
N IC,NSPA
S NSPA=77-$L(TEXT)
F IC=1:1:NSPA S TEXT=TEXT_" "
S TEXT=TEXT_"X"
Q TEXT
;
;=======================================================
QUERYAO() ;See if the user wants only active reminders listed.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YA"
S DIR("A")="List active reminders only? "
S DIR("B")="Y"
W !
D ^DIR
Q Y
;
;=======================================================
RDEF(DEFLIST,ARO) ;Build a list of the name and print name of all
;reminder definitions.
N INACTIVE,IEN,NAME,PNAME,REMINDER
S INACTIVE=""
;Build the list of reminders in alphabetical order.
S VALMCNT=0
S NAME=""
F S NAME=$O(^PXD(811.9,"B",NAME)) Q:NAME="" D
. S IEN=$O(^PXD(811.9,"B",NAME,""))
. S REMINDER=^PXD(811.9,IEN,0)
. S INACTIVE=$P(REMINDER,U,6)
. I (ARO)&(INACTIVE) Q
. S VALMCNT=VALMCNT+1
. S PNAME=$P(REMINDER,U,3)
. S DEFLIST(VALMCNT,0)=$$FRDEF(NAME,PNAME)
. I INACTIVE D
.. S DEFLIST(VALMCNT,0)=$$MRKINACT(DEFLIST(VALMCNT,0))
S DEFLIST("VALMCNT")=VALMCNT
Q
;
;=======================================================
REXL(RLIST) ;Build a list of exchange repository entries.
N DATE,EXIEN,FMTSTR,IND,NAME,NL,NUM,OUTPUT,SOURCE,STR
;Build the list in alphabetical order.
S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")
S (NUM,VALMCNT)=0
S NAME=""
F S NAME=$O(^PXD(811.8,"B",NAME)) Q:NAME="" D
. S DATE=""
. F S DATE=$O(^PXD(811.8,"B",NAME,DATE)) Q:DATE="" D
.. S EXIEN=$O(^PXD(811.8,"B",NAME,DATE,""))
.. S SOURCE=$P(^PXD(811.8,EXIEN,0),U,2)
.. S NUM=NUM+1
.. S ^TMP(RLIST,$J,"SEL",NUM)=EXIEN
.. D FMT(NUM,NAME,SOURCE,DATE,FMTSTR,.NL,.OUTPUT)
.. F IND=1:1:NL D
... S VALMCNT=VALMCNT+1,^TMP(RLIST,$J,VALMCNT,0)=OUTPUT(IND)
... S ^TMP(RLIST,$J,"IDX",VALMCNT,NUM)=""
S ^TMP(RLIST,$J,"VALMCNT")=VALMCNT
S ^TMP(RLIST,$J,"NEXCHE")=NUM
Q
;
;=======================================================
N BY,DIC,FLDS,FR,L,PXRMEDOK
S PXRMEDOK=1
S BY=".01"
S DIC="^PXRMD(811.6,"
S FLDS="[PXRM SPONSOR LIST]"
S FR=""
S L=0
D EN1^DIP
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMLIST 3331 printed Oct 16, 2024@17:47:17 Page 2
PXRMLIST ; SLC/PKR/PJH - Clinical Reminders list functions. ;01/18/2013
+1 ;;2.0;CLINICAL REMINDERS;**6,26**;Feb 04, 2005;Build 404
+2 ;Used in the reminder exchange utility for building lists of
+3 ;reminders, Exchange File entries, etc.
+4 ;=======================================================
FRDEF(NAME,PNAME) ;Format the reminder name and print name.
+1 NEW IND,TEMP
+2 SET TEMP=$$LJ^XLFSTR(NAME,40," ")
+3 SET TEMP=TEMP_PNAME
+4 QUIT TEMP
+5 ;
+6 ;=======================================================
FMT(NUMBER,NAME,SOURCE,DATE,FMTSTR,NL,OUTPUT) ;Format entry number, name,
+1 ;source, and date packed for LM display.
+2 NEW TEMP,TSOURCE
+3 SET TEMP=NUMBER_U_NAME
+4 SET TSOURCE=$EXTRACT($PIECE(SOURCE,",",1),1,12)_"@"_$EXTRACT($PIECE(SOURCE," at ",2),1,12)
+5 SET TEMP=TEMP_U_TSOURCE
+6 SET DATE=$$FMTE^XLFDT(DATE,"5Z")
+7 SET TEMP=TEMP_U_DATE
+8 DO COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
+9 QUIT
+10 ;
+11 ;=======================================================
LIST ;Print a list of location lists.
+1 NEW BY,DIC,FLDS,FR,L,PXRMEDOK
+2 SET PXRMEDOK=1
+3 SET BY=".01"
+4 SET DIC="^PXRMD(810.9,"
+5 SET FLDS="[PXRM LOCATION LIST LIST]"
+6 SET FR=""
+7 SET L=0
+8 DO EN1^DIP
+9 QUIT
+10 ;
+11 ;=======================================================
MRKINACT(TEXT) ;Append the inactive mark to TEXT in column 77.
+1 NEW IC,NSPA
+2 SET NSPA=77-$LENGTH(TEXT)
+3 FOR IC=1:1:NSPA
SET TEXT=TEXT_" "
+4 SET TEXT=TEXT_"X"
+5 QUIT TEXT
+6 ;
+7 ;=======================================================
QUERYAO() ;See if the user wants only active reminders listed.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="YA"
+3 SET DIR("A")="List active reminders only? "
+4 SET DIR("B")="Y"
+5 WRITE !
+6 DO ^DIR
+7 QUIT Y
+8 ;
+9 ;=======================================================
RDEF(DEFLIST,ARO) ;Build a list of the name and print name of all
+1 ;reminder definitions.
+2 NEW INACTIVE,IEN,NAME,PNAME,REMINDER
+3 SET INACTIVE=""
+4 ;Build the list of reminders in alphabetical order.
+5 SET VALMCNT=0
+6 SET NAME=""
+7 FOR
SET NAME=$ORDER(^PXD(811.9,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 SET IEN=$ORDER(^PXD(811.9,"B",NAME,""))
+9 SET REMINDER=^PXD(811.9,IEN,0)
+10 SET INACTIVE=$PIECE(REMINDER,U,6)
+11 IF (ARO)&(INACTIVE)
QUIT
+12 SET VALMCNT=VALMCNT+1
+13 SET PNAME=$PIECE(REMINDER,U,3)
+14 SET DEFLIST(VALMCNT,0)=$$FRDEF(NAME,PNAME)
+15 IF INACTIVE
Begin DoDot:2
+16 SET DEFLIST(VALMCNT,0)=$$MRKINACT(DEFLIST(VALMCNT,0))
End DoDot:2
End DoDot:1
+17 SET DEFLIST("VALMCNT")=VALMCNT
+18 QUIT
+19 ;
+20 ;=======================================================
REXL(RLIST) ;Build a list of exchange repository entries.
+1 NEW DATE,EXIEN,FMTSTR,IND,NAME,NL,NUM,OUTPUT,SOURCE,STR
+2 ;Build the list in alphabetical order.
+3 SET FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")
+4 SET (NUM,VALMCNT)=0
+5 SET NAME=""
+6 FOR
SET NAME=$ORDER(^PXD(811.8,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+7 SET DATE=""
+8 FOR
SET DATE=$ORDER(^PXD(811.8,"B",NAME,DATE))
if DATE=""
QUIT
Begin DoDot:2
+9 SET EXIEN=$ORDER(^PXD(811.8,"B",NAME,DATE,""))
+10 SET SOURCE=$PIECE(^PXD(811.8,EXIEN,0),U,2)
+11 SET NUM=NUM+1
+12 SET ^TMP(RLIST,$JOB,"SEL",NUM)=EXIEN
+13 DO FMT(NUM,NAME,SOURCE,DATE,FMTSTR,.NL,.OUTPUT)
+14 FOR IND=1:1:NL
Begin DoDot:3
+15 SET VALMCNT=VALMCNT+1
SET ^TMP(RLIST,$JOB,VALMCNT,0)=OUTPUT(IND)
+16 SET ^TMP(RLIST,$JOB,"IDX",VALMCNT,NUM)=""
End DoDot:3
End DoDot:2
End DoDot:1
+17 SET ^TMP(RLIST,$JOB,"VALMCNT")=VALMCNT
+18 SET ^TMP(RLIST,$JOB,"NEXCHE")=NUM
+19 QUIT
+20 ;
+21 ;=======================================================
+1 NEW BY,DIC,FLDS,FR,L,PXRMEDOK
+2 SET PXRMEDOK=1
+3 SET BY=".01"
+4 SET DIC="^PXRMD(811.6,"
+5 SET FLDS="[PXRM SPONSOR LIST]"
+6 SET FR=""
+7 SET L=0
+8 DO EN1^DIP
+9 QUIT
+10 ;
