Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWTPL

ORWTPL.m

Go to the documentation of this file. 
  1. ORWTPL ; SLC/STAFF - Personal Preference Lists ;Oct 19, 2018@10:16
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,109,173,243,273,377**;Oct 24, 2000;Build 582
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;DBIA reference section
  1.  ;4329  - ^VA(200
  1.  ;10013 - DIK
  1.  ;2263  - XPAR
  1.  ;
  1. NEWLIST(VAL,LISTNAME,USER,ORVIZ) ; from ORWTPP
  1.  ; set user's new personal list
  1.  N CAPNAME
  1.  S LISTNAME=$G(LISTNAME)
  1.  I '$L(LISTNAME) S VAL="^invalid list name" Q
  1.  S CAPNAME=$$UPPER^ORU(LISTNAME)
  1.  I $D(^OR(100.21,"D",CAPNAME)) S VAL="^invalid list name - duplicate of another name" Q
  1.  I $O(^OR(100.21,"B",LISTNAME,0)) S VAL="^invalid list name - duplicate of another name" Q
  1.  ;*** check input transform, duplicate name for same user
  1.  N DA,DIK,NUM
  1.  L +^OR(100.21,0):20 I '$T S VAL="^unable to set up" Q
  1.  S NUM=1+$P(^OR(100.21,0),U,3)
  1.  F  Q:'$D(^OR(100.21,NUM,0))  S NUM=NUM+1
  1.  S $P(^OR(100.21,0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
  1.  S ^OR(100.21,NUM,0)=LISTNAME_"^P"
  1.  L -^OR(100.21,0)
  1.  K ^OR(100.21,NUM,1),^(2),^(10)
  1.  S ^OR(100.21,NUM,1,0)="^100.212PA^"_USER_"^1"
  1.  S ^OR(100.21,NUM,1,USER,0)=USER
  1.  S ^OR(100.21,NUM,11)=$G(ORVIZ)_U
  1.  S DIK="^OR(100.21,",DA=NUM
  1.  D IX1^DIK
  1.  S VAL=NUM_U_LISTNAME_"^^^^^^^"_$G(ORVIZ)
  1.  Q
  1.  ;
  1. DELLIST(OK,LISTNUM,USER) ; from ORWTPP
  1.  ; delete user's personal list
  1.  N DA,DIK
  1.  S LISTNUM=+$G(LISTNUM),OK=1
  1.  I '$O(^OR(100.21,"C",USER,LISTNUM,0)) S OK=0 Q
  1.  I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q
  1.  S DA=LISTNUM,DIK="^OR(100.21,"
  1.  D ^DIK
  1.  Q
  1.  ;
  1. SAVELIST(OK,PLIST,LISTNUM,USER,ORVIZ) ; from ORWTPP
  1.  ; save user's personal list changes
  1.  N CNT,DA,DFN,DIK,NUM K DA
  1.  S LISTNUM=+$G(LISTNUM),OK=1
  1.  I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q
  1.  I '$D(^OR(100.21,"C",USER,LISTNUM)) S OK=0 Q
  1.  I '$D(^OR(100.21,LISTNUM,10,0))#2 S ^(0)="^100.2101AV^"
  1.  S DA(1)=LISTNUM,DIK="^OR(100.21,"_LISTNUM_",10,"
  1.  S DA=0 F  S DA=$O(^OR(100.21,LISTNUM,10,DA)) Q:DA<1  D ^DIK
  1.  K DA
  1.  S CNT=0
  1.  S NUM=0 F  S NUM=$O(PLIST(NUM)) Q:NUM<1  D
  1.  .S DFN=+PLIST(NUM) I 'DFN Q
  1.  .S CNT=CNT+1
  1.  .S ^OR(100.21,LISTNUM,10,CNT,0)=DFN_";DPT("
  1.  S ^OR(100.21,LISTNUM,10,0)="^100.2101AV^"_CNT_U_CNT
  1.  S ^OR(100.21,LISTNUM,11)=$G(ORVIZ)_U
  1.  S DA=LISTNUM,DIK="^OR(100.21,"
  1.  D IX1^DIK
  1.  Q
  1.  ;
  1. LSDEF(INFO,USER) ; from ORWTPP
  1.  ; get user's list sources
  1.  N TYPE
  1.  S INFO=""
  1.  F TYPE="P","S","T","W","C" D
  1.  .S INFO=INFO_$P($$LISTSRC^ORQPTQ11(USER,TYPE),U)_U
  1.  Q
  1.  ;
  1. SORTDEF(SORT,USER) ; from ORWTPP
  1.  ; get user's sort order - Modified by PKS - 8/30/2001
  1.  N ORSECT
  1.  S ORSECT=$G(^VA(200,USER,5))
  1.  I +ORSECT>0 S ORSECT=$P(ORSECT,U)
  1.  S SORT=$$GET^XPAR("USR.`"_USER_"^SRV.`"_$G(ORSECT)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I") I SORT']"" S SORT="A"
  1.  Q
  1.  ;
  1. CLDAYS(DAYS,USER) ; from ORWTPP
  1.  ; get user's clinic defaults
  1.  N DAY
  1.  S DAYS=""
  1.  F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D
  1.  .S DAYS=DAYS_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_DAY,1,"I")_U
  1.  Q
  1.  ;
  1. CLRANGE(RANGE,USER) ; from ORWTPP
  1.  ; get user's default clinic start, stop dates
  1.  N RNG
  1.  S RANGE=""
  1.  F RNG="START","STOP" D
  1.  .S RANGE=RANGE_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_RNG_" DATE",1,"I")_U
  1.  Q
  1.  ;
  1. SAVECD(OK,INFO,USER) ; from ORWTPP
  1.  ; save user's clinic defaults
  1.  N FRI,MON,SAT,START,STOP,SUN,THURS,TUES,WED
  1.  S OK=1
  1.  S START=+$P(INFO,U,1) S START=$S(START=0:"T",START<0:"T"_START,1:"T+"_START)
  1.  S STOP=+$P(INFO,U,2) S STOP=$S(STOP=0:"T",STOP<0:"T"_STOP,1:"T+"_STOP)
  1.  S MON=+$P(INFO,U,3),MON=$S('MON:"@",1:"`"_MON)
  1.  S TUES=+$P(INFO,U,4),TUES=$S('TUES:"@",1:"`"_TUES)
  1.  S WED=+$P(INFO,U,5),WED=$S('WED:"@",1:"`"_WED)
  1.  S THURS=+$P(INFO,U,6),THURS=$S('THURS:"@",1:"`"_THURS)
  1.  S FRI=+$P(INFO,U,7),FRI=$S('FRI:"@",1:"`"_FRI)
  1.  S SAT=+$P(INFO,U,8),SAT=$S('SAT:"@",1:"`"_SAT)
  1.  S SUN=+$P(INFO,U,9),SUN=$S('SUN:"@",1:"`"_SUN)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,START)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,STOP)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC MONDAY",1,MON)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC TUESDAY",1,TUES)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC WEDNESDAY",1,WED)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC THURSDAY",1,THURS)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC FRIDAY",1,FRI)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SATURDAY",1,SAT)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SUNDAY",1,SUN)
  1.  Q
  1.  ;
  1. SAVEPLD(OK,INFO,USER) ; from ORWTPP
  1.  ; save user's clinic defaults
  1.  N PCMM,PROV,SORT,SOURCE,SPEC,TEAM,WARD
  1.  S OK=1
  1.  S SOURCE=$P(INFO,U,1)
  1.  S SORT=$P(INFO,U,2)
  1.  S PROV=+$P(INFO,U,3),PROV=$S('PROV:"@",1:"`"_PROV)
  1.  S SPEC=+$P(INFO,U,4),SPEC=$S('SPEC:"@",1:"`"_SPEC)
  1.  S TEAM=+$P(INFO,U,5),TEAM=$S('TEAM:"@",1:"`"_TEAM)
  1.  S WARD=+$P(INFO,U,6),WARD=$S('WARD:"@",1:"`"_WARD)
  1.  S PCMM=+$P(INFO,U,7),PCMM=$S('PCMM:"@",1:"`"_PCMM) ; ajb 377
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST SOURCE",1,SOURCE)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST ORDER",1,SORT)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT PROVIDER",1,PROV)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT SPECIALTY",1,SPEC)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT TEAM",1,TEAM)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT WARD",1,WARD)
  1.  D EN^XPAR(USER_";VA(200,","ORLP DEFAULT PCMM TEAM",1,PCMM) ; ajb 377
  1.  Q