- 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 Jan 18, 2025@02:47:40 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 ;