BEHOPTP2 ;MSC/IND/DKM - Patient List Management ;20-Mar-2007 13:48;DKM
;;1.1;BEH COMPONENTS;**004002**;Mar 20, 2007
;=================================================================
; Retrieve a given list for a given user
PLSTPTS(DATA,NAME) ;EP
N TMP,ERR,CNT,LP,DFN,PTNM
S DATA(1)="^No patients found.",(CNT,LP)=0
D GETWP^XPAR(.TMP,"ALL",$$PARAM,$$GETNAME(NAME),.ERR)
F S LP=$O(TMP(LP)) Q:'LP D
.S DFN=+TMP(LP,0)
.I DFN D
..S PTNM=$$GET1^DIQ(2,DFN_",",".01")
..S:$L(PTNM) CNT=CNT+1,DATA(CNT)=DFN_U_PTNM
Q
; Retrieve a list of personal lists for a user
PLSTLST(DATA) ;EP
N ERR,LP
S LP=0
D GETLST^XPAR(.DATA,"ALL",$$PARAM,"Q",.ERR)
F S LP=$O(DATA(LP)) Q:'LP S $P(DATA(LP),U)=$$GETIEN($P(DATA(LP),U,2))
Q
; List management API
MANAGE(DATA,ACTION,NAME,VAL) ;EP
S DATA=$$VALIDATE(.NAME,ACTION="C")
Q:DATA
I ACTION="C" D SETLST(.DATA,NAME) Q
I ACTION="R" D RENLST(.DATA,NAME,.VAL) Q
I ACTION="S" D SETLST(.DATA,NAME,.VAL) Q
I ACTION="D" D DELLST(.DATA,NAME) Q
S DATA="-1^Unknown action"
Q
; Validate list name
VALIDATE(NAME,DUP) ;
N L
S NAME=$$TRIM^CIAU(NAME),L=$L(NAME),DUP=+$G(DUP)
Q:L<3!(L>30) "-1^List name must be 3-30 characters in length."
Q:NAME'?.(1A,1N,1"_",1" ") "-1^List name contains invalid characters."
I DUP,$$GETIEN(NAME) Q "-1^List name already exists."
I 'DUP,'$$GETIEN(NAME) Q "-1^List name not found."
Q ""
; Rename existing list
; OLD - Existing Instance name (aka list name)
; NEW - New list name
RENLST(DATA,OLD,NEW) ;EP
S DATA=$$VALIDATE(NEW,1)
D:'DATA REP^XPAR("USR",$$PARAM,$$GETNAME(OLD),NEW,.DATA)
D:'DATA CHG^XPAR("USR",$$PARAM,NEW,NEW,.DATA)
Q
; Set List
SETLST(DATA,NAME,VAL) ;EP
Q:'$L(NAME)
S:NAME=+NAME NAME=$$GETNAME(NAME)
S VAL=NAME
S:$D(VAL)'=11 VAL(1,0)=""
D EN^XPAR("USR",$$PARAM,NAME,.VAL,.DATA)
Q
; Delete list
; NAME - List Name
DELLST(DATA,NAME) ;EP
D DEL^XPAR("USR",$$PARAM,$$GETNAME(NAME),.DATA)
Q
; Return parameter name/ien
PARAM(X) Q $S($G(X):$$FIND1^DIC(8989.51,,,$$PARAM),1:"BEHOPTPL PERSONAL LIST")
; Return IEN to file 8989.5
GETIEN(NAME) ;
Q $S(NAME=+NAME:NAME,1:$O(^XTV(8989.5,"AC",$$PARAM(1),+DUZ_";VA(200,",NAME,0)))
; Returns instance name for 8989.5 IEN
GETNAME(IEN) ;
Q $S(IEN=+IEN:$$GET1^DIQ(8989.5,IEN_",",.03),1:IEN)
BEHOPTP2 ;MSC/IND/DKM - Patient List Management ;20-Mar-2007 13:48;DKM
+1 ;;1.1;BEH COMPONENTS;**004002**;Mar 20, 2007
+2 ;=================================================================
+3 ; Retrieve a given list for a given user
PLSTPTS(DATA,NAME) ;EP
+1 NEW TMP,ERR,CNT,LP,DFN,PTNM
+2 SET DATA(1)="^No patients found."
SET (CNT,LP)=0
+3 DO GETWP^XPAR(.TMP,"ALL",$$PARAM,$$GETNAME(NAME),.ERR)
+4 FOR
SET LP=$ORDER(TMP(LP))
IF 'LP
QUIT
Begin DoDot:1
+5 SET DFN=+TMP(LP,0)
+6 IF DFN
Begin DoDot:2
+7 SET PTNM=$$GET1^DIQ(2,DFN_",",".01")
+8 IF $LENGTH(PTNM)
SET CNT=CNT+1
SET DATA(CNT)=DFN_U_PTNM
End DoDot:2
End DoDot:1
+9 QUIT
+10 ; Retrieve a list of personal lists for a user
PLSTLST(DATA) ;EP
+1 NEW ERR,LP
+2 SET LP=0
+3 DO GETLST^XPAR(.DATA,"ALL",$$PARAM,"Q",.ERR)
+4 FOR
SET LP=$ORDER(DATA(LP))
IF 'LP
QUIT
SET $PIECE(DATA(LP),U)=$$GETIEN($PIECE(DATA(LP),U,2))
+5 QUIT
+6 ; List management API
MANAGE(DATA,ACTION,NAME,VAL) ;EP
+1 SET DATA=$$VALIDATE(.NAME,ACTION="C")
+2 IF DATA
QUIT
+3 IF ACTION="C"
DO SETLST(.DATA,NAME)
QUIT
+4 IF ACTION="R"
DO RENLST(.DATA,NAME,.VAL)
QUIT
+5 IF ACTION="S"
DO SETLST(.DATA,NAME,.VAL)
QUIT
+6 IF ACTION="D"
DO DELLST(.DATA,NAME)
QUIT
+7 SET DATA="-1^Unknown action"
+8 QUIT
+9 ; Validate list name
VALIDATE(NAME,DUP) ;
+1 NEW L
+2 SET NAME=$$TRIM^CIAU(NAME)
SET L=$LENGTH(NAME)
SET DUP=+$GET(DUP)
+3 IF L<3!(L>30)
QUIT "-1^List name must be 3-30 characters in length."
+4 IF NAME'?.(1A,1N,1"_",1" ")
QUIT "-1^List name contains invalid characters."
+5 IF DUP
IF $$GETIEN(NAME)
QUIT "-1^List name already exists."
+6 IF 'DUP
IF '$$GETIEN(NAME)
QUIT "-1^List name not found."
+7 QUIT ""
+8 ; Rename existing list
+9 ; OLD - Existing Instance name (aka list name)
+10 ; NEW - New list name
RENLST(DATA,OLD,NEW) ;EP
+1 SET DATA=$$VALIDATE(NEW,1)
+2 IF 'DATA
DO REP^XPAR("USR",$$PARAM,$$GETNAME(OLD),NEW,.DATA)
+3 IF 'DATA
DO CHG^XPAR("USR",$$PARAM,NEW,NEW,.DATA)
+4 QUIT
+5 ; Set List
SETLST(DATA,NAME,VAL) ;EP
+1 IF '$LENGTH(NAME)
QUIT
+2 IF NAME=+NAME
SET NAME=$$GETNAME(NAME)
+3 SET VAL=NAME
+4 IF $DATA(VAL)'=11
SET VAL(1,0)=""
+5 DO EN^XPAR("USR",$$PARAM,NAME,.VAL,.DATA)
+6 QUIT
+7 ; Delete list
+8 ; NAME - List Name
DELLST(DATA,NAME) ;EP
+1 DO DEL^XPAR("USR",$$PARAM,$$GETNAME(NAME),.DATA)
+2 QUIT
+3 ; Return parameter name/ien
PARAM(X) QUIT $SELECT($GET(X):$$FIND1^DIC(8989.51,,,$$PARAM),1:"BEHOPTPL PERSONAL LIST")
+1 ; Return IEN to file 8989.5
GETIEN(NAME) ;
+1 QUIT $SELECT(NAME=+NAME:NAME,1:$ORDER(^XTV(8989.5,"AC",$$PARAM(1),+DUZ_";VA(200,",NAME,0)))
+2 ; Returns instance name for 8989.5 IEN
GETNAME(IEN) ;
+1 QUIT $SELECT(IEN=+IEN:$$GET1^DIQ(8989.5,IEN_",",.03),1:IEN)
