Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLIST.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLIST.m
r613 r623 1 PXRMLIST ; SLC/PKR/PJH - Clinical Reminders list functions. ;07/17/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ;Used in the reminder exchange utility for building lists of 4 ;reminders, Exchange File entries, etc. 5 ;======================================================= 6 FRDEF(NAME,PNAME) ;Format the reminder name and print name. 7 N IND,TEMP 8 S TEMP=$$LJ^XLFSTR(NAME,40," ") 9 S TEMP=TEMP_PNAME 10 Q TEMP 11 ; 12 ;======================================================= 13 FMT(NUMBER,NAME,SOURCE,DATE,FMTSTR,NL,OUTPUT) ;Format entry number, name, 14 ;source, and date packed for LM display. 15 N TEMP,TSOURCE 16 S TEMP=NUMBER_U_NAME 17 S TSOURCE=$E($P(SOURCE,",",1),1,12)_"@"_$E($P(SOURCE," at ",2),1,12) 18 S TEMP=TEMP_U_TSOURCE 19 S DATE=$$FMTE^XLFDT(DATE,"5Z") 20 S TEMP=TEMP_U_DATE 21 D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT) 22 Q 23 ; 24 ;======================================================= 25 LIST ;Print a list of location lists. 26 N BY,DIC,FLDS,FR,L,PXRMEDOK 27 S PXRMEDOK=1 28 S BY=".01" 29 S DIC="^PXRMD(810.9," 30 S FLDS="[PXRM LOCATION LIST LIST]" 31 S FR="" 32 S L=0 33 D EN1^DIP 34 Q 35 ; 36 ;======================================================= 37 MRKINACT(TEXT) ;Append the inactive mark to TEXT in column 77. 38 N IC,NSPA 39 S NSPA=77-$L(TEXT) 40 F IC=1:1:NSPA S TEXT=TEXT_" " 41 S TEXT=TEXT_"X" 42 Q TEXT 43 ; 44 ;======================================================= 45 QUERYAO() ;See if the user wants only active reminders listed. 46 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y 47 S DIR(0)="YA" 48 S DIR("A")="List active reminders only? " 49 S DIR("B")="Y" 50 W ! 51 D ^DIR 52 Q Y 53 ; 54 ;======================================================= 55 RDEF(DEFLIST,ARO) ;Build a list of the name and print name of all 56 ;reminder definitions. 57 N INACTIVE,IEN,NAME,PNAME,REMINDER 58 S INACTIVE="" 59 ;Build the list of reminders in alphabetical order. 60 S VALMCNT=0 61 S NAME="" 62 F S NAME=$O(^PXD(811.9,"B",NAME)) Q:NAME="" D 63 . S IEN=$O(^PXD(811.9,"B",NAME,"")) 64 . S REMINDER=^PXD(811.9,IEN,0) 65 . S INACTIVE=$P(REMINDER,U,6) 66 . I (ARO)&(INACTIVE) Q 67 . S VALMCNT=VALMCNT+1 68 . S PNAME=$P(REMINDER,U,3) 69 . S DEFLIST(VALMCNT,0)=$$FRDEF(NAME,PNAME) 70 . I INACTIVE D 71 .. S DEFLIST(VALMCNT,0)=$$MRKINACT(DEFLIST(VALMCNT,0)) 72 S DEFLIST("VALMCNT")=VALMCNT 73 Q 74 ; 75 ;======================================================= 76 REXL(RLIST) ;Build a list of exchange repository entries. 77 N DATE,EXIEN,FMTSTR,IND,NAME,NL,NUM,OUTPUT,SOURCE,STR 78 ;Build the list in alphabetical order. 79 S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL") 80 S (NUM,VALMCNT)=0 81 S NAME="" 82 F S NAME=$O(^PXD(811.8,"B",NAME)) Q:NAME="" D 83 . S DATE="" 84 . F S DATE=$O(^PXD(811.8,"B",NAME,DATE)) Q:DATE="" D 85 .. S EXIEN=$O(^PXD(811.8,"B",NAME,DATE,"")) 86 .. S SOURCE=$P(^PXD(811.8,EXIEN,0),U,2) 87 .. S NUM=NUM+1 88 .. S ^TMP(RLIST,$J,"SEL",NUM)=EXIEN 89 .. D FMT(NUM,NAME,SOURCE,DATE,FMTSTR,.NL,.OUTPUT) 90 .. F IND=1:1:NL D 91 ... S VALMCNT=VALMCNT+1,^TMP(RLIST,$J,VALMCNT,0)=OUTPUT(IND) 92 ... S ^TMP(RLIST,$J,"IDX",VALMCNT,NUM)="" 93 S ^TMP(RLIST,$J,"VALMCNT")=VALMCNT 94 Q 95 ; 96 ;======================================================= 97 SPONSOR ;Print a list of Sponsors. 98 N BY,DIC,FLDS,FR,L,PXRMEDOK 99 S PXRMEDOK=1 100 S BY=".01" 101 S DIC="^PXRMD(811.6," 102 S FLDS="[PXRM SPONSOR LIST]" 103 S FR="" 104 S L=0 105 D EN1^DIP 106 Q 107 ; 1 PXRMLIST ; SLC/PKR/PJH - Clinical Reminders list functions. ;10/04/2000 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ;Used in the reminder exchange utility for building lists of 4 ;reminders, Exchange File entries, etc. 5 ;======================================================= 6 FRDEF(NAME,PNAME) ;Format the reminder name and print name. 7 N IND,TEMP 8 S TEMP=$$LJ^XLFSTR(NAME,40," ") 9 S TEMP=TEMP_PNAME 10 Q TEMP 11 ; 12 ;======================================================= 13 FRE(NUMBER,NAME,SOURCE,DATE) ;Format entry number, name, source, 14 ;and date packed. 15 N TEMP,TNAME,TSOURCE 16 S TEMP=$$RJ^XLFSTR(NUMBER,4," ") 17 S TNAME=$E(NAME,1,27) 18 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,29," ") 19 S TSOURCE=$E($P(SOURCE,",",1),1,12)_"@"_$E($P(SOURCE," at ",2),1,12) 20 S TEMP=TEMP_$$LJ^XLFSTR(TSOURCE,23," ") 21 S DATE=$$FMTE^XLFDT(DATE,"5Z") 22 S TEMP=TEMP_" "_$$LJ^XLFSTR(DATE,30," ") 23 Q TEMP 24 ; 25 ;======================================================= 26 LIST ;Print a list of location lists. 27 N BY,DIC,FLDS,FR,L,PXRMEDOK 28 S PXRMEDOK=1 29 S BY=".01" 30 S DIC="^PXRMD(810.9," 31 S FLDS="[PXRM LOCATION LIST LIST]" 32 S FR="" 33 S L=0 34 D EN1^DIP 35 Q 36 ; 37 ;======================================================= 38 MRKINACT(TEXT) ;Append the inactive mark to TEXT in column 77. 39 N IC,NSPA 40 S NSPA=77-$L(TEXT) 41 F IC=1:1:NSPA S TEXT=TEXT_" " 42 S TEXT=TEXT_"X" 43 Q TEXT 44 ; 45 ;======================================================= 46 QUERYAO() ;See if the user wants only active reminders listed. 47 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y 48 S DIR(0)="YA" 49 S DIR("A")="List active reminders only? " 50 S DIR("B")="Y" 51 W ! 52 D ^DIR 53 Q Y 54 ; 55 ;======================================================= 56 RDEF(DEFLIST,ARO) ;Build a list of the name and print name of all 57 ;reminder definitions. 58 N INACTIVE,IEN,NAME,PNAME,REMINDER 59 S INACTIVE="" 60 ;Build the list of reminders in alphabetical order. 61 S VALMCNT=0 62 S NAME="" 63 F S NAME=$O(^PXD(811.9,"B",NAME)) Q:NAME="" D 64 . S IEN=$O(^PXD(811.9,"B",NAME,"")) 65 . S REMINDER=^PXD(811.9,IEN,0) 66 . S INACTIVE=$P(REMINDER,U,6) 67 . I (ARO)&(INACTIVE) Q 68 . S VALMCNT=VALMCNT+1 69 . S PNAME=$P(REMINDER,U,3) 70 . S DEFLIST(VALMCNT,0)=$$FRDEF(NAME,PNAME) 71 . I INACTIVE D 72 .. S DEFLIST(VALMCNT,0)=$$MRKINACT(DEFLIST(VALMCNT,0)) 73 S DEFLIST("VALMCNT")=VALMCNT 74 Q 75 ; 76 ;======================================================= 77 RE(RLIST,IEN) ;Build a list of repository entries. 78 N DATE,IND,NAME,SOURCE 79 ;Build the list in alphabetical order. 80 S VALMCNT=0 81 S NAME="" 82 F S NAME=$O(^PXD(811.8,"B",NAME)) Q:NAME="" D 83 . S DATE="" 84 . F S DATE=$O(^PXD(811.8,"B",NAME,DATE)) Q:DATE="" D 85 .. S IND=$O(^PXD(811.8,"B",NAME,DATE,"")) 86 .. S SOURCE=$P(^PXD(811.8,IND,0),U,2) 87 .. S VALMCNT=VALMCNT+1 88 .. S RLIST(VALMCNT,0)=$$FRE(VALMCNT,NAME,SOURCE,DATE) 89 .. S IEN(VALMCNT)=IND 90 S RLIST("VALMCNT")=VALMCNT 91 Q 92 ; 93 ;======================================================= 94 SPONSOR ;Print a list of Sponsors. 95 N BY,DIC,FLDS,FR,L,PXRMEDOK 96 S PXRMEDOK=1 97 S BY=".01" 98 S DIC="^PXRMD(811.6," 99 S FLDS="[PXRM SPONSOR LIST]" 100 S FR="" 101 S L=0 102 D EN1^DIP 103 Q 104 ;
Note:
See TracChangeset
for help on using the changeset viewer.
