- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPL.m
r613 r623 1 ORWTPL ; SLC/STAFF Personal Preference - Lists ; 3/11/08 6:36am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,109,173,243**;Oct 24, 2000;Build 242 3 ; 4 NEWLIST(VAL,LISTNAME,USER,ORVIZ) ; from ORWTPP 5 ; set user's new personal list 6 S LISTNAME=$G(LISTNAME) 7 I '$L(LISTNAME) S VAL="^invalid list name" Q 8 I $O(^OR(100.21,"B",LISTNAME,0)) S VAL="^invalid list name - duplicate of another name" Q 9 ;*** check input transform, duplicate name for same user 10 N DA,DIK,NUM 11 L +^OR(100.21,0):20 I '$T S VAL="^unable to set up" Q 12 S NUM=1+$P(^OR(100.21,0),U,3) 13 F Q:'$D(^OR(100.21,NUM,0)) S NUM=NUM+1 14 S $P(^OR(100.21,0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1 15 S ^OR(100.21,NUM,0)=LISTNAME_"^P" 16 L -^OR(100.21,0) 17 K ^OR(100.21,NUM,1),^(2),^(10) 18 S ^OR(100.21,NUM,1,0)="^100.212PA^"_USER_"^1" 19 S ^OR(100.21,NUM,1,USER,0)=USER 20 S ^OR(100.21,NUM,11)=$G(ORVIZ)_U 21 S DIK="^OR(100.21,",DA=NUM 22 D IX1^DIK 23 S VAL=NUM_U_LISTNAME_"^^^^^^^"_$G(ORVIZ) 24 Q 25 ; 26 DELLIST(OK,LISTNUM,USER) ; from ORWTPP 27 ; delete user's personal list 28 N DA,DIK 29 S LISTNUM=+$G(LISTNUM),OK=1 30 I '$O(^OR(100.21,"C",USER,LISTNUM,0)) S OK=0 Q 31 I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q 32 S DA=LISTNUM,DIK="^OR(100.21," 33 D ^DIK 34 Q 35 ; 36 SAVELIST(OK,PLIST,LISTNUM,USER,ORVIZ) ; from ORWTPP 37 ; save user's personal list changes 38 N CNT,DA,DFN,DIK,NUM K DA 39 S LISTNUM=+$G(LISTNUM),OK=1 40 I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q 41 I '$D(^OR(100.21,"C",USER,LISTNUM)) S OK=0 Q 42 I '$D(^OR(100.21,LISTNUM,10,0))#2 S ^(0)="^100.2101AV^" 43 S DA(1)=LISTNUM,DIK="^OR(100.21,"_LISTNUM_",10," 44 S DA=0 F S DA=$O(^OR(100.21,LISTNUM,10,DA)) Q:DA<1 D ^DIK 45 K DA 46 S CNT=0 47 S NUM=0 F S NUM=$O(PLIST(NUM)) Q:NUM<1 D 48 .S DFN=+PLIST(NUM) I 'DFN Q 49 .S CNT=CNT+1 50 .S ^OR(100.21,LISTNUM,10,CNT,0)=DFN_";DPT(" 51 S ^OR(100.21,LISTNUM,10,0)="^100.2101AV^"_CNT_U_CNT 52 S ^OR(100.21,LISTNUM,11)=$G(ORVIZ)_U 53 S DA=LISTNUM,DIK="^OR(100.21," 54 D IX1^DIK 55 Q 56 ; 57 LSDEF(INFO,USER) ; from ORWTPP 58 ; get user's list sources 59 N TYPE 60 S INFO="" 61 F TYPE="P","S","T","W","C" D 62 .S INFO=INFO_$P($$LISTSRC^ORQPTQ11(USER,TYPE),U)_U 63 Q 64 ; 65 SORTDEF(SORT,USER) ; from ORWTPP 66 ; get user's sort order - Modified by PKS - 8/30/2001 67 N ORSECT 68 S ORSECT=$G(^VA(200,USER,5)) 69 I +ORSECT>0 S ORSECT=$P(ORSECT,U) 70 S SORT=$$GET^XPAR("USR.`"_USER_"^SRV.`"_$G(ORSECT)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I") I SORT']"" S SORT="A" 71 Q 72 ; 73 CLDAYS(DAYS,USER) ; from ORWTPP 74 ; get user's clinic defaults 75 N DAY 76 S DAYS="" 77 F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D 78 .S DAYS=DAYS_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_DAY,1,"I")_U 79 Q 80 ; 81 CLRANGE(RANGE,USER) ; from ORWTPP 82 ; get user's default clinic start, stop dates 83 N RNG 84 S RANGE="" 85 F RNG="START","STOP" D 86 .S RANGE=RANGE_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_RNG_" DATE",1,"I")_U 87 Q 88 ; 89 SAVECD(OK,INFO,USER) ; from ORWTPP 90 ; save user's clinic defaults 91 N FRI,MON,SAT,START,STOP,SUN,THURS,TUES,WED 92 S OK=1 93 S START=+$P(INFO,U,1) S START=$S(START=0:"T",START<0:"T"_START,1:"T+"_START) 94 S STOP=+$P(INFO,U,2) S STOP=$S(STOP=0:"T",STOP<0:"T"_STOP,1:"T+"_STOP) 95 S MON=+$P(INFO,U,3),MON=$S('MON:"@",1:"`"_MON) 96 S TUES=+$P(INFO,U,4),TUES=$S('TUES:"@",1:"`"_TUES) 97 S WED=+$P(INFO,U,5),WED=$S('WED:"@",1:"`"_WED) 98 S THURS=+$P(INFO,U,6),THURS=$S('THURS:"@",1:"`"_THURS) 99 S FRI=+$P(INFO,U,7),FRI=$S('FRI:"@",1:"`"_FRI) 100 S SAT=+$P(INFO,U,8),SAT=$S('SAT:"@",1:"`"_SAT) 101 S SUN=+$P(INFO,U,9),SUN=$S('SUN:"@",1:"`"_SUN) 102 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,START) 103 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,STOP) 104 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC MONDAY",1,MON) 105 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC TUESDAY",1,TUES) 106 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC WEDNESDAY",1,WED) 107 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC THURSDAY",1,THURS) 108 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC FRIDAY",1,FRI) 109 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SATURDAY",1,SAT) 110 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SUNDAY",1,SUN) 111 Q 112 ; 113 SAVEPLD(OK,INFO,USER) ; from ORWTPP 114 ; save user's clinic defaults 115 N PROV,SORT,SOURCE,SPEC,TEAM,WARD 116 S OK=1 117 S SOURCE=$P(INFO,U,1) 118 S SORT=$P(INFO,U,2) 119 S PROV=+$P(INFO,U,3),PROV=$S('PROV:"@",1:"`"_PROV) 120 S SPEC=+$P(INFO,U,4),SPEC=$S('SPEC:"@",1:"`"_SPEC) 121 S TEAM=+$P(INFO,U,5),TEAM=$S('TEAM:"@",1:"`"_TEAM) 122 S WARD=+$P(INFO,U,6),WARD=$S('WARD:"@",1:"`"_WARD) 123 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST SOURCE",1,SOURCE) 124 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST ORDER",1,SORT) 125 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT PROVIDER",1,PROV) 126 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT SPECIALTY",1,SPEC) 127 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT TEAM",1,TEAM) 128 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT WARD",1,WARD) 129 Q 1 ORWTPL ; SLC/STAFF Personal Preference - Lists ;4/30/01 11:04 [5/19/03 3:11pm] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,109,173**;Oct 24, 2000 3 ; 4 NEWLIST(VAL,LISTNAME,USER) ; from ORWTPP 5 ; set user's new personal list 6 S LISTNAME=$G(LISTNAME) 7 I '$L(LISTNAME) S VAL="^invalid list name" Q 8 I $O(^OR(100.21,"B",LISTNAME,0)) S VAL="^invalid list name - duplicate of another name" Q 9 ;*** check input transform, duplicate name for same user 10 N DA,DIK,NUM 11 L +^OR(100.21,0):20 I '$T S VAL="^unable to set up" Q 12 S NUM=1+$P(^OR(100.21,0),U,3) 13 F Q:'$D(^OR(100.21,NUM,0)) S NUM=NUM+1 14 S $P(^OR(100.21,0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1 15 S ^OR(100.21,NUM,0)=LISTNAME_"^P" 16 L -^OR(100.21,0) 17 K ^OR(100.21,NUM,1),^(2),^(10) 18 S ^OR(100.21,NUM,1,0)="^100.212PA^"_USER_"^1" 19 S ^OR(100.21,NUM,1,USER,0)=USER 20 S DIK="^OR(100.21,",DA=NUM 21 D IX1^DIK 22 S VAL=NUM_U_LISTNAME 23 Q 24 ; 25 DELLIST(OK,LISTNUM,USER) ; from ORWTPP 26 ; delete user's personal list 27 N DA,DIK 28 S LISTNUM=+$G(LISTNUM),OK=1 29 I '$O(^OR(100.21,"C",USER,LISTNUM,0)) S OK=0 Q 30 I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q 31 S DA=LISTNUM,DIK="^OR(100.21," 32 D ^DIK 33 Q 34 ; 35 SAVELIST(OK,PLIST,LISTNUM,USER) ; from ORWTPP 36 ; save user's personal list changes 37 N CNT,DA,DFN,DIK,NUM K DA 38 S LISTNUM=+$G(LISTNUM),OK=1 39 I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q 40 I '$D(^OR(100.21,"C",USER,LISTNUM)) S OK=0 Q 41 I '$D(^OR(100.21,LISTNUM,10,0))#2 S ^(0)="^100.2101AV^" 42 S DA(1)=LISTNUM,DIK="^OR(100.21,"_LISTNUM_",10," 43 S DA=0 F S DA=$O(^OR(100.21,LISTNUM,10,DA)) Q:DA<1 D ^DIK 44 K DA 45 S CNT=0 46 S NUM=0 F S NUM=$O(PLIST(NUM)) Q:NUM<1 D 47 .S DFN=+PLIST(NUM) I 'DFN Q 48 .S CNT=CNT+1 49 .S ^OR(100.21,LISTNUM,10,CNT,0)=DFN_";DPT(" 50 S ^OR(100.21,LISTNUM,10,0)="^100.2101AV^"_CNT_U_CNT 51 S DA=LISTNUM,DIK="^OR(100.21," 52 D IX1^DIK 53 Q 54 ; 55 LSDEF(INFO,USER) ; from ORWTPP 56 ; get user's list sources 57 N TYPE 58 S INFO="" 59 F TYPE="P","S","T","W","C" D 60 .S INFO=INFO_$P($$LISTSRC^ORQPTQ11(USER,TYPE),U)_U 61 Q 62 ; 63 SORTDEF(SORT,USER) ; from ORWTPP 64 ; get user's sort order - Modified by PKS - 8/30/2001 65 N ORSECT 66 S ORSECT=$G(^VA(200,USER,5)) 67 I +ORSECT>0 S ORSECT=$P(ORSECT,U) 68 S SORT=$$GET^XPAR("USR.`"_USER_"^SRV.`"_$G(ORSECT)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I") I SORT']"" S SORT="A" 69 Q 70 ; 71 CLDAYS(DAYS,USER) ; from ORWTPP 72 ; get user's clinic defaults 73 N DAY 74 S DAYS="" 75 F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D 76 .S DAYS=DAYS_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_DAY,1,"I")_U 77 Q 78 ; 79 CLRANGE(RANGE,USER) ; from ORWTPP 80 ; get user's default clinic start, stop dates 81 N RNG 82 S RANGE="" 83 F RNG="START","STOP" D 84 .S RANGE=RANGE_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_RNG_" DATE",1,"I")_U 85 Q 86 ; 87 SAVECD(OK,INFO,USER) ; from ORWTPP 88 ; save user's clinic defaults 89 N FRI,MON,SAT,START,STOP,SUN,THURS,TUES,WED 90 S OK=1 91 S START=+$P(INFO,U,1) S START=$S(START=0:"T",START<0:"T"_START,1:"T+"_START) 92 S STOP=+$P(INFO,U,2) S STOP=$S(STOP=0:"T",STOP<0:"T"_STOP,1:"T+"_STOP) 93 S MON=+$P(INFO,U,3),MON=$S('MON:"@",1:"`"_MON) 94 S TUES=+$P(INFO,U,4),TUES=$S('TUES:"@",1:"`"_TUES) 95 S WED=+$P(INFO,U,5),WED=$S('WED:"@",1:"`"_WED) 96 S THURS=+$P(INFO,U,6),THURS=$S('THURS:"@",1:"`"_THURS) 97 S FRI=+$P(INFO,U,7),FRI=$S('FRI:"@",1:"`"_FRI) 98 S SAT=+$P(INFO,U,8),SAT=$S('SAT:"@",1:"`"_SAT) 99 S SUN=+$P(INFO,U,9),SUN=$S('SUN:"@",1:"`"_SUN) 100 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,START) 101 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,STOP) 102 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC MONDAY",1,MON) 103 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC TUESDAY",1,TUES) 104 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC WEDNESDAY",1,WED) 105 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC THURSDAY",1,THURS) 106 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC FRIDAY",1,FRI) 107 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SATURDAY",1,SAT) 108 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SUNDAY",1,SUN) 109 Q 110 ; 111 SAVEPLD(OK,INFO,USER) ; from ORWTPP 112 ; save user's clinic defaults 113 N PROV,SORT,SOURCE,SPEC,TEAM,WARD 114 S OK=1 115 S SOURCE=$P(INFO,U,1) 116 S SORT=$P(INFO,U,2) 117 S PROV=+$P(INFO,U,3),PROV=$S('PROV:"@",1:"`"_PROV) 118 S SPEC=+$P(INFO,U,4),SPEC=$S('SPEC:"@",1:"`"_SPEC) 119 S TEAM=+$P(INFO,U,5),TEAM=$S('TEAM:"@",1:"`"_TEAM) 120 S WARD=+$P(INFO,U,6),WARD=$S('WARD:"@",1:"`"_WARD) 121 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST SOURCE",1,SOURCE) 122 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST ORDER",1,SORT) 123 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT PROVIDER",1,PROV) 124 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT SPECIALTY",1,SPEC) 125 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT TEAM",1,TEAM) 126 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT WARD",1,WARD) 127 Q
Note:
See TracChangeset
for help on using the changeset viewer.
