Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPAU.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/PXRMLPAU.m
r613 r623 1 PXRMLPAU ; SLC/AGP - Reminder Patient List ;09/06/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ;Main entry point for PXRM PATIENT LIST 5 START(IEN) ; 6 N PXRMDONE,VALMBCK,VALMSG,X,XMZ 7 S X="IORESET" 8 S VALMCNT=0 9 D EN^VALM("PXRM PATIENT LIST AUTH USERS") 10 W IORESET 11 Q 12 ; 13 BLDLIST ; 14 N PLIST,PIEN 15 K ^TMP("PXRMLPAU",$J) 16 K ^TMP("PXRMLPAH",$J) 17 D LIST(.PLIST,.PIEN) 18 I $D(PLIST)=0 G EXIT 19 M ^TMP("PXRMLPAU",$J)=PLIST 20 S VALMCNT=PLIST("VALMCNT") 21 F IND=1:1:VALMCNT D 22 .S ^TMP("PXRMLPAU",$J,"IDX",IND,IND)=PIEN(IND) 23 Q 24 ; 25 LIST(RLIST,PIEN) ;Build a list of patient list users. 26 N ACCESS,ARRAY,COUNT,DATE,DFN,IND,SIEN,FNAME,NAME,NODE,LEVEL 27 ;Build the list in alphabetical order. 28 S VALMCNT=0 29 S DFN="" 30 F S DFN=$O(^PXRMXP(810.5,IEN,40,"B",DFN)) Q:DFN="" D 31 .S IND="" 32 .F S IND=$O(^PXRMXP(810.5,IEN,40,"B",DFN,IND)) Q:'IND D 33 ..S ACCESS=$P($G(^PXRMXP(810.5,IEN,40,IND,0)),U,2) 34 ..S FNAME=$$GET1^DIQ(200,DFN,.01) Q:$G(FNAME)="" 35 ..S ARRAY(FNAME)=$G(IND)_U_$G(ACCESS) 36 I $D(ARRAY)=0 Q 37 S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D 38 .S VALMCNT=VALMCNT+1 39 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,NAME,$P($G(ARRAY(NAME)),U,2)) 40 .S PIEN(VALMCNT)=$P($G(ARRAY(NAME)),U) 41 S RLIST("VALMCNT")=VALMCNT 42 Q 43 ; 44 FRE(NUMBER,NAME,ACCESS) ;Format entry number, name, source, 45 ;and date packed. 46 N TEMP,TNAME,TSOURCE 47 S TEMP=$$RJ^XLFSTR(NUMBER,5," ") 48 S TNAME=$E(NAME,1,45) 49 S TEMP=TEMP_" "_TNAME 50 S TEMP=$$LJ^XLFSTR(TEMP,40," ")_ACCESS 51 Q TEMP 52 ; 53 ENTRY ;Entry code 54 D BLDLIST,XQORM 55 Q 56 ; 57 EXIT ;Exit code 58 K ^TMP("PXRMLPAU",$J) 59 K ^TMP("PXRMLPAH",$J) 60 D CLEAN^VALM10 61 D FULL^VALM1 62 Q 63 ; 64 HDR ; Header code 65 S VALMHDR(1)="Available Patient Lists." 66 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 67 Q 68 ; 69 HLP ;Help code 70 N ORU,ORUPRMT,SUB,XQORM 71 S SUB="PXRMLPAH" 72 D EN^VALM("PXRM PATIENT LIST HELP") 73 Q 74 ; 75 INIT ;Init 76 S VALMCNT=0 77 Q 78 ; 79 PEXIT ;PXRM MENU protocol exit code 80 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 81 ;Reset after page up/down etc 82 D XQORM 83 Q 84 ; 85 ADD ;add a user 86 N CREAT,CNT,DIC,DIE,FDA,MSG,USER,Y 87 S CREAT=$P($G(^PXRMXP(810.5,IEN,0)),U,7) 88 I $G(CREAT)'=DUZ D G ADDE 89 . W !,"Only the creator of this list can add an user." H 2 90 D FULL^VALM1 91 S DIC="^VA(200," 92 S DIC(0)="QAEB" 93 S DIC("A")="Select Users: " 94 D ^DIC 95 I Y=-1 Q 96 S USER=+Y 97 K Y 98 K DIROUT,DIRUT,DTOUT,DUOUT 99 S DIR(0)="S^F:Full Control;V:View Only" 100 S DIR("A")="Select level of control: " 101 S DIR("B")="V" 102 S DIR("?")="Enter F or V. For detailed help type ??" 103 W ! 104 D ^DIR K DIR 105 I $D(DIROUT) S DTOUT=1 106 I $D(DTOUT)!($D(DUOUT)) Q 107 I $G(Y)="" W !,"A level of control must be entered." H 2 Q 108 S YESNO=$E(Y(0)) 109 S FDA(810.54,"+2,"_IEN_",",.01)=USER 110 S FDA(810.54,"+2,"_IEN_",",1)=Y 111 D UPDATE^DIE("","FDA","","MSG") 112 I $D(MSG)>0 D AWRITE^PXRMUTIL("MSG") H 2 113 ADDE ; 114 D BLDLIST 115 S VALMBCK="R" 116 Q 117 ; 118 XQORM ; 119 S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST AUTH USER SELECT",0))_U_"1:"_VALMCNT 120 S XQORM("A")="Select Item: " 121 Q 122 ; 123 XSEL ;PXRM SELECT COMPONENT validation 124 N EPIEN,LISTIEN,LRIEN,SEL 125 S SEL=$P(XQORNOD(0),"=",2) 126 ;Remove trailing , 127 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 128 ;Invalid selection 129 I SEL["," D Q 130 .W $C(7),!,"Only one item number allowed." H 2 131 .S VALMBCK="R" 132 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q 133 .W $C(7),!,SEL_" is not a valid item number." H 2 134 .S VALMBCK="R" 135 ;Get the patient list ien 136 S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",SEL,SEL) 137 ;Full screen mode 138 D FULL^VALM1 139 D PDELETE 140 ; 141 ;Option to Install, Delete or Install History 142 ; 143 S VALMBCK="R" 144 Q 145 ; 146 HELP(CALL) ;General help text routine 147 N HTEXT 148 I CALL=1 D 149 .S HTEXT(1)="Select CO to copy the patient list.\\" 150 .S HTEXT(2)="Select COE to copy the patient list to an OE/RR Team.\\" 151 .S HTEXT(3)="Select DE to delete the patient list.\\" 152 .S HTEXT(4)="Select DSP to display the patient list.\\" 153 D HELP^PXRMEUT(.HTEXT) 154 Q 155 ; 156 PDELETE ;Patient list delete 157 ; 158 ;Full Screen 159 W IORESET 160 ; 161 N CREAT,IND,LISTIEN,NODE 162 I DUZ'=$P($G(^PXRMXP(810.5,IEN,0)),U,7) D G PDELEX 163 .W !,"Only the creator of this list can delete it." H 2 164 D EN^VALM2(XQORNOD(0)) 165 ;If there is no list quit. 166 I '$D(VALMY) D BLDLIST S VALMBCK="R" Q 167 S IND="",PXRMDONE=0 168 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 169 .;Get the patient list ien. 170 .S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",IND,IND) 171 .S DA(1)=IEN,DA=LISTIEN,DIK="^PXRMXP(810.5,"_DA(1)_",40," D ^DIK 172 .W !,"Patient list deleted" 173 ; 174 PDELEX ; 175 D BLDLIST 176 ; 177 S VALMBCK="R" 178 Q 179 ; 1 PXRMLPAU ; SLC/AGP - Reminder Patient List ;07/29/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ;Main entry point for PXRM PATIENT LIST 5 START(IEN) ; 6 N PXRMDONE,VALMBCK,VALMSG,X,XMZ 7 S X="IORESET" 8 S VALMCNT=0 9 D EN^VALM("PXRM PATIENT LIST AUTH USERS") 10 W IORESET 11 Q 12 ; 13 BLDLIST ; 14 N PLIST,PIEN 15 K ^TMP("PXRMLPAU",$J) 16 K ^TMP("PXRMLPAH",$J) 17 D LIST(.PLIST,.PIEN) 18 I $D(PLIST)=0 G EXIT 19 M ^TMP("PXRMLPAU",$J)=PLIST 20 S VALMCNT=PLIST("VALMCNT") 21 F IND=1:1:VALMCNT D 22 .S ^TMP("PXRMLPAU",$J,"IDX",IND,IND)=PIEN(IND) 23 Q 24 ; 25 LIST(RLIST,PIEN) ;Build a list of patient list users. 26 N ACCESS,ARRAY,COUNT,DATE,DFN,IND,SIEN,FNAME,NAME,NODE,LEVEL 27 ;Build the list in alphabetical order. 28 S VALMCNT=0 29 S DFN="" 30 F S DFN=$O(^PXRMXP(810.5,IEN,40,"B",DFN)) Q:DFN="" D 31 .S IND="" 32 .F S IND=$O(^PXRMXP(810.5,IEN,40,"B",DFN,IND)) Q:'IND D 33 ..S ACCESS=$P($G(^PXRMXP(810.5,IEN,40,IND,0)),U,2) 34 ..S FNAME=$$GET1^DIQ(200,DFN,.01) Q:$G(FNAME)="" 35 ..S ARRAY(FNAME)=$G(IND)_U_$G(ACCESS) 36 I $D(ARRAY)=0 Q 37 S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D 38 .S VALMCNT=VALMCNT+1 39 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,NAME,$P($G(ARRAY(NAME)),U,2)) 40 .S PIEN(VALMCNT)=$P($G(ARRAY(NAME)),U) 41 S RLIST("VALMCNT")=VALMCNT 42 Q 43 ; 44 FRE(NUMBER,NAME,ACCESS) ;Format entry number, name, source, 45 ;and date packed. 46 N TEMP,TNAME,TSOURCE 47 S TEMP=$$RJ^XLFSTR(NUMBER,5," ") 48 S TNAME=$E(NAME,1,45) 49 S TEMP=TEMP_" "_TNAME 50 S TEMP=$$LJ^XLFSTR(TEMP,40," ")_ACCESS 51 Q TEMP 52 ; 53 ENTRY ;Entry code 54 D BLDLIST,XQORM 55 Q 56 ; 57 EXIT ;Exit code 58 K ^TMP("PXRMLPAU",$J) 59 K ^TMP("PXRMLPAH",$J) 60 D CLEAN^VALM10 61 D FULL^VALM1 62 Q 63 ; 64 HDR ; Header code 65 S VALMHDR(1)="Available Patient Lists." 66 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 67 Q 68 ; 69 HLP ;Help code 70 N ORU,ORUPRMT,SUB,XQORM 71 S SUB="PXRMLPAH" 72 D EN^VALM("PXRM PATIENT LIST HELP") 73 Q 74 ; 75 INIT ;Init 76 S VALMCNT=0 77 Q 78 ; 79 PEXIT ;PXRM MENU protocol exit code 80 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 81 ;Reset after page up/down etc 82 D XQORM 83 Q 84 ; 85 ADD ;add a users 86 N CREAT,CNT,DIC,DIE,FDA,MSG,USER,Y 87 S CREAT=$P($G(^PXRMXP(810.5,IEN,0)),U,7) 88 I $G(CREAT)'=DUZ D G ADDE 89 . W !,"Only the creator of this list can add an user." H 2 90 D FULL^VALM1 91 S DIC="^VA(200," 92 S DIC(0)="QAEB" 93 S DIC("A")="Select Users: " 94 D ^DIC 95 I Y=-1 Q 96 S USER=+Y 97 K Y 98 K DIROUT,DIRUT,DTOUT,DUOUT 99 S DIR(0)="S^F:Full Control;V:View Only" 100 S DIR("A")="Select level of control: " 101 S DIR("B")="V" 102 S DIR("?")="Enter F or V. For detailed help type ??" 103 W ! 104 D ^DIR K DIR 105 I $D(DIROUT) S DTOUT=1 106 I $D(DTOUT)!($D(DUOUT)) Q 107 I $G(Y)="" W !,"A status must be enter" H 2 Q 108 S YESNO=$E(Y(0)) 109 S FDA(810.54,"+2,"_IEN_",",.01)=USER 110 S FDA(810.54,"+2,"_IEN_",",1)=Y 111 D UPDATE^DIE("","FDA","","MSG") 112 I $D(MSG)>0 D AWRITE^PXRMUTIL("MSG") H 2 113 ADDE ; 114 D BLDLIST 115 S VALMBCK="R" 116 Q 117 ; 118 XQORM ; 119 S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST AUTH USER SELECT",0))_U_"1:"_VALMCNT 120 S XQORM("A")="Select Item: " 121 Q 122 ; 123 XSEL ;PXRM SELECT COMPONENT validation 124 N EPIEN,LISTIEN,LRIEN,SEL 125 S SEL=$P(XQORNOD(0),"=",2) 126 ;Remove trailing , 127 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 128 ;Invalid selection 129 I SEL["," D Q 130 .W $C(7),!,"Only one item number allowed." H 2 131 .S VALMBCK="R" 132 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q 133 .W $C(7),!,SEL_" is not a valid item number." H 2 134 .S VALMBCK="R" 135 ;Get the patient list ien 136 S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",SEL,SEL) 137 ;Full screen mode 138 D FULL^VALM1 139 D PDELETE 140 ; 141 ;Option to Install, Delete or Install History 142 ; 143 S VALMBCK="R" 144 Q 145 ; 146 HELP(CALL) ;General help text routine 147 N HTEXT 148 ; 149 I CALL=1 D 150 .S HTEXT(1)="Select CO to copy patient list." 151 .S HTEXT(2)="Select COE to copy patient list to OE/RR Team." 152 .S HTEXT(3)="Select CR to delete patient list." 153 .S HTEXT(4)="Select DSP to display patient list." 154 ; 155 D HELP^PXRMEUT(.HTEXT) 156 Q 157 ; 158 PDELETE ;Patient list delete 159 ; 160 ;Full Screen 161 W IORESET 162 ; 163 N CREAT,IND,LISTIEN,NODE 164 I DUZ'=$P($G(^PXRMXP(810.5,IEN,0)),U,7) D G PDELEX 165 .W !,"Only the creator of this list can delete an user." H 2 166 D EN^VALM2(XQORNOD(0)) 167 ;If there is no list quit. 168 I '$D(VALMY) D BLDLIST S VALMBCK="R" Q 169 S IND="",PXRMDONE=0 170 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 171 .;Get the patient list ien. 172 .S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",IND,IND) 173 .S DA(1)=IEN,DA=LISTIEN,DIK="^PXRMXP(810.5,"_DA(1)_",40," D ^DIK 174 .W !,"PATIENT DELETED" 175 ; 176 PDELEX ; 177 D BLDLIST 178 ; 179 S VALMBCK="R" 180 Q 181 ;
Note:
See TracChangeset
for help on using the changeset viewer.
