ORLPREML ;ISP/LMT - List Manager CPRS Team List from a Reminder Patient List ;11/13/17 12:55
;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
;
;
EN ; -- main entry point for ORLP TEAM LIST FROM REM
D EN^VALM("ORLP TEAM LIST FROM REM")
Q
;
HDR ; -- header code
;
; ZEXCEPT: VALMHDR
N ORTASK
;
S ORTASK=$$GETTASK
I ORTASK="" D Q
. S VALMHDR(1)=" << Option ORLP TEAM LIST FROM REM is not scheduled in TaskMan! >>"
;
S VALMHDR(1)=" << Option ORLP TEAM LIST FROM REM is next scheduled to run: "_$$FMTE^XLFDT($P(ORTASK,U,2),"2M")_". >>"
;
Q
;
INIT ; -- init variables and list array
;
; ZEXCEPT: VALMAR,VALMCNT
N ORCNT,ORDIV,ORENT,ORENTCNT,ORENTNM,ORFREQ,ORLASTRUN,ORLASTUPD,ORLINE,ORLINEVAR,ORLST
N ORLSTNM,ORNEXTRUN,ORNODE,OROVER,ORREM,ORREMNM
;
K ^TMP("ORLPREM",$J)
K ^TMP("ORLPREM-MAP",$J)
;
D GETAPARS("E")
;
S ORCNT=0
S ORLINE=0
;
I '$D(^TMP("ORLPREM",$J)) D
. S ORLINE=ORLINE+1
. S ORLINEVAR=""
. S ORLINEVAR=$$SETFLD^VALM1(">> There are currently no mappings.",ORLINEVAR,"ERROR")
. D SET^VALM10(ORLINE,ORLINEVAR)
;
S ORREMNM=""
F S ORREMNM=$O(^TMP("ORLPREM",$J,ORREMNM)) Q:ORREMNM="" D
. S ORCNT=ORCNT+1
. S ORREM=$G(^TMP("ORLPREM",$J,ORREMNM))
. S ^TMP("ORLPREM-MAP",$J,ORCNT)=ORREM
. S ORLASTRUN=$$GETLAST(ORREM)
. S ORFREQ=$$GETFREQ(ORREM)
. S OROVER=$$GETOVER(ORREM)
. S OROVER=$S(OROVER=0:"NO",1:"YES")
. ;
. S ORENTCNT=0
. S ORENT=""
. F S ORENT=$O(^TMP("ORLPREM",$J,ORREMNM,ORENT)) Q:ORENT="" D
. . S ORENTCNT=ORENTCNT+1
. . S ORNODE=$G(^TMP("ORLPREM",$J,ORREMNM,ORENT))
. . S ORLST=$P(ORNODE,U,1)
. . S ORLSTNM=$P(ORNODE,U,2)
. . I ORENT="SYS",ORENTCNT=1 S ORDIV="All"
. . I ORENT="SYS",ORENTCNT'=1 S ORDIV="Catch-All"
. . I ORENT S ORDIV=$$STA^XUAF4(ORENT)
. . ;
. . S ORLINE=ORLINE+1
. . S ORLINEVAR=""
. . I ORENTCNT=1 D
. . . S ORLINEVAR=$$SETFLD^VALM1(ORCNT,ORLINEVAR,"NUM")
. . . S ORLINEVAR=$$SETFLD^VALM1(ORREMNM,ORLINEVAR,"REM")
. . . S ORLINEVAR=$$SETFLD^VALM1($$FMTE^XLFDT(ORLASTRUN,"2M"),ORLINEVAR,"LASTRUN")
. . . S ORLINEVAR=$$SETFLD^VALM1(ORFREQ_$S(ORFREQ:"D",1:""),ORLINEVAR,"FREQ")
. . ;
. . S ORLINEVAR=$$SETFLD^VALM1(ORDIV,ORLINEVAR,"DIV")
. . S ORLINEVAR=$$SETFLD^VALM1(ORLSTNM,ORLINEVAR,"LIST")
. . S ORLASTUPD=$$LASTUPD(ORLST)
. . S ORLASTUPD=$$FMTE^XLFDT(ORLASTUPD,"2M")
. . S ORLINEVAR=$$SETFLD^VALM1(ORLASTUPD,ORLINEVAR,"LASTUPD")
. . I ORENTCNT=1 D
. . . S ORNEXTRUN=$P($$GETSCHED(ORREM),U,3)
. . . I ORNEXTRUN S ORNEXTRUN=$$FMTE^XLFDT(ORNEXTRUN,"2M")
. . . S ORLINEVAR=$$SETFLD^VALM1(ORNEXTRUN,ORLINEVAR,"NEXTRUN")
. . . S ORLINEVAR=$$SETFLD^VALM1(OROVER,ORLINEVAR,"OVER")
. . D SET^VALM10(ORLINE,ORLINEVAR,ORCNT)
;
S VALMCNT=ORLINE
;
K ^TMP("ORLPREM",$J)
;
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAN^VALM10
K ^TMP("ORLPREM-MAP",$J)
Q
;
EXPND ; -- expand code
Q
;
KEYS ;
;
; ZEXCEPT: XQORM
N ORI,ORPROT
;
K XQORM("KEY") ;TODO - IS THIS NECESSARY?
S ORPROT=$O(^ORD(101,"B","ORLPREM EDIT ENTRY",0))
I 'ORPROT Q
;
S ORI=0
F S ORI=$O(^TMP("ORLPREM-MAP",$J,ORI)) Q:'ORI D
. S XQORM("KEY",ORI)=ORPROT_"^1"
;
Q
;
SELECT(ORACTION) ;
;
; ZEXCEPT: XQORNOD
N DIR,DIRUT,ORREM,X,Y
;
D FULL^VALM1
;
I '$O(^TMP("ORLPREM-MAP",$J,0)) D Q 0
. W !,"There are no items to "_ORACTION_".",!
. H 5
;
S Y=+$P(XQORNOD(0),"^",3)
;
I 'Y D
. S DIR(0)="NO^1:"_$O(^TMP("ORLPREM-MAP",$J,""),-1)_":0"
. S DIR("A")="Select Entry"
. D ^DIR
I $D(DIRUT) Q 0
I Y'>0 Q 0
;
S ORREM=$G(^TMP("ORLPREM-MAP",$J,Y))
I 'ORREM D Q 0
. W !,"This entry does not have a list rule mapping to "_ORACTION_".",!
. H 5
;
Q ORREM
;
ADDENT ; Add an Entry
;
D FULL^VALM1
;
D PAR
;
;I $G(VALMAR)'="" K @VALMAR
D REFRESH
;
Q
;
EDITENT ; Edit an Entry
;
N ORREM
;
S ORREM=$$SELECT("edit")
I 'ORREM Q
;
D PAR(ORREM)
;
D REFRESH
;
Q
;
DELENT ; Delete an Entry
;
; ZEXCEPT: XQORNOD
N DIR,DIRUT,ORENT,ORLST,ORREM,X,Y
;
S ORREM=$$SELECT("delete")
I 'ORREM Q
;
S DIR(0)="Y"
S DIR("A")="Are you sure you want to delete the mappings for "_$P($G(^PXRM(810.4,+ORREM,0)),U,1)
S DIR("?",1)="If you select 'Yes', it will delete the team list mappings and defined"
S DIR("?")="frequency for this reminder list rule."
S DIR("B")="NO"
D ^DIR
I $G(DIRUT)!(Y'=1) Q
;
D DEL^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
D DEL^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
;
D GETPARS(.ORLST,ORREM)
S ORENT=""
F S ORENT=$O(ORLST(ORENT)) Q:ORENT="" D
. I ORENT="SYS" D Q
. . D DEL^XPAR("SYS","ORLP TEAM LIST FROM REM","`"_ORREM)
. I ORENT D Q
. . D DEL^XPAR(ORENT_";DIC(4,","ORLP TEAM LIST FROM REM","`"_ORREM)
;
D REFRESH
;
Q
;
RUNNOW ; Run one of the List Rules now
;
N DIR,DIRUT,ORARR,ORLSTMAP,ORREM,ORREMNM,ORTSK,ORVAR,X,Y
;
D FULL^VALM1
;
I '$O(^TMP("ORLPREM-MAP",$J,0)) D Q
. W !,"There are no items to select from.",!
. H 5
;
S DIR(0)="NO^1:"_$O(^TMP("ORLPREM-MAP",$J,""),-1)_":0"
S DIR("A")="Select Entry"
D ^DIR
I $D(DIRUT) Q
I Y'>0 Q
;
S ORREM=$G(^TMP("ORLPREM-MAP",$J,Y))
I 'ORREM D Q
. W !,"This entry does not have a list rule mapping to run.",!
. H 5
;
D GETPARS^ORLPREML(.ORLSTMAP,ORREM)
I '$D(ORLSTMAP) D Q
. W !,"This entry is not mapped to any Team Lists.",!
. H 5
;
S ORREMNM=$P($G(^PXRM(810.4,+ORREM,0)),U,1)
;
K DIR,Y,X
S DIR(0)="Y"
S DIR("B")="NO"
S DIR("A")="Do you want to run "_ORREMNM_" now"
D ^DIR
I $D(DIRUT) Q
I Y'=1 Q
;
D EN^XPAR("SYS","ORLP TEAM LIST FROM REM LAST","`"_ORREM,"@")
S ORVAR="ORREM;ORLSTMAP("
S ORARR("ZTDTH")=$H
S ORTSK=$$NODEV^XUTMDEVQ("ENONE^ORLPREM","Run List Rule to Update Team List",ORVAR,.ORARR,0)
W !!,"Task #"_ORTSK_" queued.",!!
H 2
;
D REFRESH
;
Q
;
REFRESH ; Refresh List
D CLEAN^VALM10
D INIT
Q
;
ENPAR ; Configure paramaters - loop till exit
;
N ORPAR
;
S ORPAR=""
F D Q:ORPAR<0
. S ORPAR=$$PAR
;
Q
;
PAR(ORREM) ; configure paramaters. Add/Edit Entry
;
N ORFILTER,ORFLAG,ORFREQ,OROVER,ORPARDEF,ORPARS,ORREQ
;
I '$G(ORREM) S ORREM=$$SELREM
I ORREM<1 Q -1
;
S ORPARDEF=$$GETPARS(.ORPARS,ORREM)
;
S ORFILTER=0
I ORPARDEF=2 S ORFILTER=1
; ask if nothing already set for list rule
I ORPARDEF<1 S ORFILTER=$$SELFLTR
I ORFILTER<0!(ORFILTER="") Q ORFILTER
;
S ORFLAG=1
W !
;
I ORFILTER D
. W !!,?3,">> First, you will need to select a team list to be used in cases"
. W !,?3,">> where it cannot be determined which division a patient belongs to."
. W !
. S ORREQ=0
. I ORPARDEF=2 S ORREQ=1
. S ORFLAG=$$PARSYS(ORREM,.ORPARS,ORREQ)
. I ORFLAG<1 Q
. ;
. W !!,?3,">> Now, you can select the team lists to be used for each division."
. S ORFLAG=$$PARDIV(ORREM,.ORPARS)
;
I 'ORFILTER S ORFLAG=$$PARSYS(ORREM,.ORPARS)
;
K ORPARS
S ORPARDEF=$$GETPARS(.ORPARS,ORREM)
I ORPARDEF D
. S ORFREQ=$$SELFREQ(ORREM)
. I ORFREQ<0 S ORFLAG=-1 Q
. S OROVER=$$SELOVER(ORREM)
. I OROVER<0 S ORFLAG=-1 Q
. W !
;I 'ORPARDEF D
;. D EN^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM,"@",.ORERR)
;
Q ORFLAG
;
PARDIV(ORREM,ORPARS) ; Configure ORLP TEAM LIST FROM REM at the div level
;
N ORDIV,ORERR,ORFLAG,ORLST,ORLSTSCR
;
S ORFLAG=1
S ORDIV=""
S ORLST=""
D LSTSCR(.ORLSTSCR,ORREM)
;
F D Q:((ORDIV<1)!(ORLST<1))
. W !
. S ORDIV=$$SELDIV
. I ORDIV<1 Q
. S ORLST=$G(ORPARS(ORDIV))
. S ORLST=$$SELLST(ORLST,.ORLSTSCR)
. I $G(ORPARS(ORDIV)),'ORLST S ORLST="@"
. I ORLST<1,ORLST'="@" Q
. D EN^XPAR(ORDIV_";DIC(4,","ORLP TEAM LIST FROM REM","`"_ORREM,$S(ORLST="@":"",1:"`")_ORLST,.ORERR)
. I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
;
I ((ORDIV<0)!(ORLST<0)) S ORFLAG=-1
;
Q ORFLAG
;
PARSYS(ORREM,ORPARS,ORREQ) ; Configure ORLP TEAM LIST FROM REM at the sys level
;
N ORERR,ORFLAG,ORLST,ORLSTSCR
;
S ORFLAG=1
D LSTSCR(.ORLSTSCR,ORREM)
;
S ORLST=$G(ORPARS("SYS"))
S ORLST=$$SELLST(ORLST,.ORLSTSCR,$G(ORREQ))
I $G(ORPARS("SYS")),'ORLST S ORLST="@"
I ORLST<1,ORLST'="@" Q ORLST
D EN^XPAR("SYS","ORLP TEAM LIST FROM REM","`"_ORREM,$S(ORLST="@":"",1:"`")_ORLST,.ORERR)
I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
;
I ORLST<0 S ORFLAG=-1
;
Q ORFLAG
;
SELFLTR() ; Ask user if they want to filter by div
;
N DIR,DIRUT,ORFILTER,X,Y
;
W !
S DIR(0)="YO"
S DIR("B")="NO"
S DIR("A")="Do you want to filter patients by Division"
S DIR("?",1)="If you want to filter the patients by division, for example, to have patients"
S DIR("?",2)="from division A added to one team list and patients from division B"
S DIR("?")="added to another team list, enter YES."
D ^DIR
I $D(DIRUT) Q -1
S ORFILTER=Y
W !
;
Q ORFILTER
;
SELDIV() ; prompt for div
;
N DIC,DINUM,DLAYGO,DTOUT,DUOUT,ORDIV,X,Y
;
S ORDIV=""
;
S DIC=4
S DIC(0)="AEMNQO"
S DIC("A")="Select DIVISION: "
D ^DIC
I $D(DTOUT)!($D(DUOUT)) Q -1
S ORDIV=+Y
I ORDIV<0 S ORDIV=""
;
Q ORDIV
;
SELREM() ; prompt for reminder list rule
;
N DIC,DINUM,DLAYGO,DTOUT,DUOUT,ORREM,X,Y
;
S DIC=810.4
S DIC(0)="AEMNQO"
S DIC("S")="I $P(^(0),U,3)=3"
D ^DIC
I $D(DTOUT)!($D(DUOUT)) Q -1
S ORREM=+Y
I ORREM<0 S ORREM=""
;
Q ORREM
;
SELLST(ORDEF,ORLSTSCR,ORREQ) ; prompt for OE/RR List
;
; ORDEF = Default 100.21 Entry
; ORLSTSCR = don't allow user to select entries in this array
; ORREQ = Should user be forced to select an entry
;
N DIR,DIRUT,DTOUT,DUOUT,ORLST,X,Y
;
S DIR(0)="PO^100.21:QEM"
I $G(ORREQ) S DIR(0)="P^100.21:QEM"
I $G(ORDEF) S DIR("B")=$P($G(^OR(100.21,ORDEF,0)),U,1)
S DIR("S")="I '$D(ORLSTSCR(Y))"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q -1
S ORLST=+Y
I ORLST<0 S ORLST=""
;
Q ORLST
;
LSTSCR(ORRET,ORREM) ; return array of 100.21 entries that should be used for screening
;
N ORENT,ORLST,ORPARS,ORREM2
;
D ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM")
S ORENT=""
F S ORENT=$O(ORPARS(ORENT)) Q:ORENT="" D
. S ORREM2=0
. F S ORREM2=$O(ORPARS(ORENT,ORREM2)) Q:'ORREM2 D
. . I ORREM=ORREM2 Q
. . S ORLST=$G(ORPARS(ORENT,ORREM2))
. . I ORLST="" Q
. . I '$D(^OR(100.21,ORLST)) Q
. . S ORRET(ORLST)=""
;
Q
;
SELFREQ(ORREM) ; Configure ORLP TEAM LIST FROM REM FREQ
;
N DIR,DIRUT,DTOUT,DUOUT,ORFREQ,ORERR,X,Y
;
S ORFREQ=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
;
W !
;
S DIR(0)="NO^1:365:0"
I ORFREQ>0 S DIR("B")=ORFREQ
S DIR("A")="Enter the frequency (in days) the team list should be updated"
S DIR("?",1)="Enter how often (in days) the reminder list rule should run"
S DIR("?")="in order to update the team list"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q -1
S ORFREQ=Y
;
I ORFREQ>0!(ORFREQ="") D
. D EN^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM,$S(ORFREQ="":"@",1:ORFREQ),.ORERR)
. ;I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
;
Q ORFREQ
;
SELOVER(ORREM) ; Configure ORLP TEAM LIST FROM REM OVER
;
N DIR,DIRUT,DTOUT,DUOUT,OROVER,ORERR,X,Y
;
S OROVER=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
;
W !
;
S DIR(0)="YO"
S DIR("B")="YES"
I OROVER'="" S DIR("B")=$S(OROVER=0:"NO",1:"YES")
S DIR("A")="Should the Rem Patient List be overwritten when updating a Team List"
S DIR("?",1)="Enter 'NO' if you want the previous Reminder Patient List not to be overwritten"
S DIR("?")="when updating a Team List"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q -1
S OROVER=Y
;
I OROVER=1!(OROVER=0)!(OROVER="") D
. D EN^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM,$S(OROVER="":"@",1:OROVER),.ORERR)
. ;I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
;
Q OROVER
;
GETPARS(ORRET,ORREM) ; Get team maapping for one list rule
;
N ORLST,ORPAR,ORPARDEF,ORPARS
;
S ORPARDEF=0
;
D ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM","`"_ORREM)
S ORPAR=""
F S ORPAR=$O(ORPARS(ORPAR)) Q:ORPAR="" D
. S ORLST=$G(ORPARS(ORPAR,ORREM))
. I ORLST="" Q
. I '$D(^OR(100.21,ORLST)) Q
. I ORPAR[";DIC(4.2," D
. . S ORRET("SYS")=ORLST
. . I ORPARDEF'=2 S ORPARDEF=1
. I ORPAR[";DIC(4," D
. . S ORRET(+ORPAR)=ORLST
. . S ORPARDEF=2
;
Q ORPARDEF
;
GETAPARS(ORFORMAT) ; Get team maapping for all list rules
;
N ORENT,ORENTNM,ORLST,ORLSTNM,ORPARS,ORREM,ORREMNM
;
I $G(ORFORMAT)'="E" S ORFORMAT="I"
;
D ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM")
S ORENT=""
F S ORENT=$O(ORPARS(ORENT)) Q:ORENT="" D
. S ORREM=0
. F S ORREM=$O(ORPARS(ORENT,ORREM)) Q:'ORREM D
. . S ORREMNM=$P($G(^PXRM(810.4,+ORREM,0)),U,1)
. . I ORREMNM="" Q ;TODO - delete this par
. . S ORLST=$G(ORPARS(ORENT,ORREM))
. . S ORLSTNM=$P($G(^OR(100.21,+ORLST,0)),U,1)
. . I ORLSTNM="" Q ;TODO - delete this par
. . I ORFORMAT="E" D
. . . S ^TMP("ORLPREM",$J,ORREMNM)=ORREM
. . S ORENTNM=""
. . I ORENT[";DIC(4.2," D
. . . S ORENTNM="SYS"
. . I ORENT[";DIC(4," D
. . . S ORENTNM=+ORENT
. . I ORENTNM="" Q ;TODO - delete this par
. . I ORFORMAT="E" D
. . . S ^TMP("ORLPREM",$J,ORREMNM,ORENTNM)=ORLST_U_ORLSTNM
. . I ORFORMAT="I" D
. . . S ^TMP("ORLPREM",$J,ORREM,ORENTNM)=ORLST
;
Q
;
GETSCHED(ORREM) ;
;
; Returns: Last time the List rule was ran to update the OE/RR List
; ^ Frequency (in days) that it runs
; ^ Next scheduled run time
;
N ORFREQ,ORLASTRUN,ORNEXTRUN,ORPARS,ORPARDEF,ORTASK,ORTASKDT
;
S ORLASTRUN=$$GETLAST(ORREM)
S ORFREQ=$$GETFREQ(ORREM)
S ORNEXTRUN=""
S ORTASK=$$GETTASK
S ORTASKDT=$P(ORTASK,U,2)
S ORPARDEF=$$GETPARS(.ORPARS,ORREM)
I ORTASKDT,ORFREQ,ORPARDEF D
. I 'ORLASTRUN D Q
. . S ORNEXTRUN=ORTASKDT
. S ORNEXTRUN=$P(ORLASTRUN,".",1)_"."_$P(ORTASKDT,".",2)
. S ORNEXTRUN=$$FMADD^XLFDT(ORNEXTRUN,ORFREQ)
;
Q ORLASTRUN_U_ORFREQ_U_ORNEXTRUN
;
GETLAST(ORREM) ; returns ORLP TEAM LIST FROM REM LAST par
Q $$GET^XPAR("SYS","ORLP TEAM LIST FROM REM LAST","`"_ORREM)
;
GETFREQ(ORREM) ; returns ORLP TEAM LIST FROM REM FREQ par
Q $$GET^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
;
GETOVER(ORREM) ; returns ORLP TEAM LIST FROM REM OVER par
N OROVER
S OROVER=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
I OROVER'=0 S OROVER=1
Q OROVER
;
GETTASK() ;
;
; returns task number^scheduled time^reschedule freq^special queuing flag
; of ORLP TEAM LIST FROM REM task
;
N ORLST,ORRET,ORX
;
S ORRET=""
D OPTSTAT^XUTMOPT("ORLP TEAM LIST FROM REM",.ORLST)
S ORX=$O(ORLST(0))
I ORX,$P($G(ORLST(ORX)),U,1)'="" D
. S ORRET=$G(ORLST(ORX))
;
Q ORRET
;
LASTUPD(ORLST) ; Returns Last Updated D/T (100.21, 12.1) for a given list
Q $P($G(^OR(100.21,+$G(ORLST),12)),U,1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLPREML 14831 printed Dec 13, 2024@02:31:35 Page 2
ORLPREML ;ISP/LMT - List Manager CPRS Team List from a Reminder Patient List ;11/13/17 12:55
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
+2 ;
+3 ;
EN ; -- main entry point for ORLP TEAM LIST FROM REM
+1 DO EN^VALM("ORLP TEAM LIST FROM REM")
+2 QUIT
+3 ;
HDR ; -- header code
+1 ;
+2 ; ZEXCEPT: VALMHDR
+3 NEW ORTASK
+4 ;
+5 SET ORTASK=$$GETTASK
+6 IF ORTASK=""
Begin DoDot:1
+7 SET VALMHDR(1)=" << Option ORLP TEAM LIST FROM REM is not scheduled in TaskMan! >>"
End DoDot:1
QUIT
+8 ;
+9 SET VALMHDR(1)=" << Option ORLP TEAM LIST FROM REM is next scheduled to run: "_$$FMTE^XLFDT($PIECE(ORTASK,U,2),"2M")_". >>"
+10 ;
+11 QUIT
+12 ;
INIT ; -- init variables and list array
+1 ;
+2 ; ZEXCEPT: VALMAR,VALMCNT
+3 NEW ORCNT,ORDIV,ORENT,ORENTCNT,ORENTNM,ORFREQ,ORLASTRUN,ORLASTUPD,ORLINE,ORLINEVAR,ORLST
+4 NEW ORLSTNM,ORNEXTRUN,ORNODE,OROVER,ORREM,ORREMNM
+5 ;
+6 KILL ^TMP("ORLPREM",$JOB)
+7 KILL ^TMP("ORLPREM-MAP",$JOB)
+8 ;
+9 DO GETAPARS("E")
+10 ;
+11 SET ORCNT=0
+12 SET ORLINE=0
+13 ;
+14 IF '$DATA(^TMP("ORLPREM",$JOB))
Begin DoDot:1
+15 SET ORLINE=ORLINE+1
+16 SET ORLINEVAR=""
+17 SET ORLINEVAR=$$SETFLD^VALM1(">> There are currently no mappings.",ORLINEVAR,"ERROR")
+18 DO SET^VALM10(ORLINE,ORLINEVAR)
End DoDot:1
+19 ;
+20 SET ORREMNM=""
+21 FOR
SET ORREMNM=$ORDER(^TMP("ORLPREM",$JOB,ORREMNM))
if ORREMNM=""
QUIT
Begin DoDot:1
+22 SET ORCNT=ORCNT+1
+23 SET ORREM=$GET(^TMP("ORLPREM",$JOB,ORREMNM))
+24 SET ^TMP("ORLPREM-MAP",$JOB,ORCNT)=ORREM
+25 SET ORLASTRUN=$$GETLAST(ORREM)
+26 SET ORFREQ=$$GETFREQ(ORREM)
+27 SET OROVER=$$GETOVER(ORREM)
+28 SET OROVER=$SELECT(OROVER=0:"NO",1:"YES")
+29 ;
+30 SET ORENTCNT=0
+31 SET ORENT=""
+32 FOR
SET ORENT=$ORDER(^TMP("ORLPREM",$JOB,ORREMNM,ORENT))
if ORENT=""
QUIT
Begin DoDot:2
+33 SET ORENTCNT=ORENTCNT+1
+34 SET ORNODE=$GET(^TMP("ORLPREM",$JOB,ORREMNM,ORENT))
+35 SET ORLST=$PIECE(ORNODE,U,1)
+36 SET ORLSTNM=$PIECE(ORNODE,U,2)
+37 IF ORENT="SYS"
IF ORENTCNT=1
SET ORDIV="All"
+38 IF ORENT="SYS"
IF ORENTCNT'=1
SET ORDIV="Catch-All"
+39 IF ORENT
SET ORDIV=$$STA^XUAF4(ORENT)
+40 ;
+41 SET ORLINE=ORLINE+1
+42 SET ORLINEVAR=""
+43 IF ORENTCNT=1
Begin DoDot:3
+44 SET ORLINEVAR=$$SETFLD^VALM1(ORCNT,ORLINEVAR,"NUM")
+45 SET ORLINEVAR=$$SETFLD^VALM1(ORREMNM,ORLINEVAR,"REM")
+46 SET ORLINEVAR=$$SETFLD^VALM1($$FMTE^XLFDT(ORLASTRUN,"2M"),ORLINEVAR,"LASTRUN")
+47 SET ORLINEVAR=$$SETFLD^VALM1(ORFREQ_$SELECT(ORFREQ:"D",1:""),ORLINEVAR,"FREQ")
End DoDot:3
+48 ;
+49 SET ORLINEVAR=$$SETFLD^VALM1(ORDIV,ORLINEVAR,"DIV")
+50 SET ORLINEVAR=$$SETFLD^VALM1(ORLSTNM,ORLINEVAR,"LIST")
+51 SET ORLASTUPD=$$LASTUPD(ORLST)
+52 SET ORLASTUPD=$$FMTE^XLFDT(ORLASTUPD,"2M")
+53 SET ORLINEVAR=$$SETFLD^VALM1(ORLASTUPD,ORLINEVAR,"LASTUPD")
+54 IF ORENTCNT=1
Begin DoDot:3
+55 SET ORNEXTRUN=$PIECE($$GETSCHED(ORREM),U,3)
+56 IF ORNEXTRUN
SET ORNEXTRUN=$$FMTE^XLFDT(ORNEXTRUN,"2M")
+57 SET ORLINEVAR=$$SETFLD^VALM1(ORNEXTRUN,ORLINEVAR,"NEXTRUN")
+58 SET ORLINEVAR=$$SETFLD^VALM1(OROVER,ORLINEVAR,"OVER")
End DoDot:3
+59 DO SET^VALM10(ORLINE,ORLINEVAR,ORCNT)
End DoDot:2
End DoDot:1
+60 ;
+61 SET VALMCNT=ORLINE
+62 ;
+63 KILL ^TMP("ORLPREM",$JOB)
+64 ;
+65 QUIT
+66 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 DO CLEAN^VALM10
+2 KILL ^TMP("ORLPREM-MAP",$JOB)
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
KEYS ;
+1 ;
+2 ; ZEXCEPT: XQORM
+3 NEW ORI,ORPROT
+4 ;
+5 ;TODO - IS THIS NECESSARY?
KILL XQORM("KEY")
+6 SET ORPROT=$ORDER(^ORD(101,"B","ORLPREM EDIT ENTRY",0))
+7 IF 'ORPROT
QUIT
+8 ;
+9 SET ORI=0
+10 FOR
SET ORI=$ORDER(^TMP("ORLPREM-MAP",$JOB,ORI))
if 'ORI
QUIT
Begin DoDot:1
+11 SET XQORM("KEY",ORI)=ORPROT_"^1"
End DoDot:1
+12 ;
+13 QUIT
+14 ;
SELECT(ORACTION) ;
+1 ;
+2 ; ZEXCEPT: XQORNOD
+3 NEW DIR,DIRUT,ORREM,X,Y
+4 ;
+5 DO FULL^VALM1
+6 ;
+7 IF '$ORDER(^TMP("ORLPREM-MAP",$JOB,0))
Begin DoDot:1
+8 WRITE !,"There are no items to "_ORACTION_".",!
+9 HANG 5
End DoDot:1
QUIT 0
+10 ;
+11 SET Y=+$PIECE(XQORNOD(0),"^",3)
+12 ;
+13 IF 'Y
Begin DoDot:1
+14 SET DIR(0)="NO^1:"_$ORDER(^TMP("ORLPREM-MAP",$JOB,""),-1)_":0"
+15 SET DIR("A")="Select Entry"
+16 DO ^DIR
End DoDot:1
+17 IF $DATA(DIRUT)
QUIT 0
+18 IF Y'>0
QUIT 0
+19 ;
+20 SET ORREM=$GET(^TMP("ORLPREM-MAP",$JOB,Y))
+21 IF 'ORREM
Begin DoDot:1
+22 WRITE !,"This entry does not have a list rule mapping to "_ORACTION_".",!
+23 HANG 5
End DoDot:1
QUIT 0
+24 ;
+25 QUIT ORREM
+26 ;
ADDENT ; Add an Entry
+1 ;
+2 DO FULL^VALM1
+3 ;
+4 DO PAR
+5 ;
+6 ;I $G(VALMAR)'="" K @VALMAR
+7 DO REFRESH
+8 ;
+9 QUIT
+10 ;
EDITENT ; Edit an Entry
+1 ;
+2 NEW ORREM
+3 ;
+4 SET ORREM=$$SELECT("edit")
+5 IF 'ORREM
QUIT
+6 ;
+7 DO PAR(ORREM)
+8 ;
+9 DO REFRESH
+10 ;
+11 QUIT
+12 ;
DELENT ; Delete an Entry
+1 ;
+2 ; ZEXCEPT: XQORNOD
+3 NEW DIR,DIRUT,ORENT,ORLST,ORREM,X,Y
+4 ;
+5 SET ORREM=$$SELECT("delete")
+6 IF 'ORREM
QUIT
+7 ;
+8 SET DIR(0)="Y"
+9 SET DIR("A")="Are you sure you want to delete the mappings for "_$PIECE($GET(^PXRM(810.4,+ORREM,0)),U,1)
+10 SET DIR("?",1)="If you select 'Yes', it will delete the team list mappings and defined"
+11 SET DIR("?")="frequency for this reminder list rule."
+12 SET DIR("B")="NO"
+13 DO ^DIR
+14 IF $GET(DIRUT)!(Y'=1)
QUIT
+15 ;
+16 DO DEL^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
+17 DO DEL^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
+18 ;
+19 DO GETPARS(.ORLST,ORREM)
+20 SET ORENT=""
+21 FOR
SET ORENT=$ORDER(ORLST(ORENT))
if ORENT=""
QUIT
Begin DoDot:1
+22 IF ORENT="SYS"
Begin DoDot:2
+23 DO DEL^XPAR("SYS","ORLP TEAM LIST FROM REM","`"_ORREM)
End DoDot:2
QUIT
+24 IF ORENT
Begin DoDot:2
+25 DO DEL^XPAR(ORENT_";DIC(4,","ORLP TEAM LIST FROM REM","`"_ORREM)
End DoDot:2
QUIT
End DoDot:1
+26 ;
+27 DO REFRESH
+28 ;
+29 QUIT
+30 ;
RUNNOW ; Run one of the List Rules now
+1 ;
+2 NEW DIR,DIRUT,ORARR,ORLSTMAP,ORREM,ORREMNM,ORTSK,ORVAR,X,Y
+3 ;
+4 DO FULL^VALM1
+5 ;
+6 IF '$ORDER(^TMP("ORLPREM-MAP",$JOB,0))
Begin DoDot:1
+7 WRITE !,"There are no items to select from.",!
+8 HANG 5
End DoDot:1
QUIT
+9 ;
+10 SET DIR(0)="NO^1:"_$ORDER(^TMP("ORLPREM-MAP",$JOB,""),-1)_":0"
+11 SET DIR("A")="Select Entry"
+12 DO ^DIR
+13 IF $DATA(DIRUT)
QUIT
+14 IF Y'>0
QUIT
+15 ;
+16 SET ORREM=$GET(^TMP("ORLPREM-MAP",$JOB,Y))
+17 IF 'ORREM
Begin DoDot:1
+18 WRITE !,"This entry does not have a list rule mapping to run.",!
+19 HANG 5
End DoDot:1
QUIT
+20 ;
+21 DO GETPARS^ORLPREML(.ORLSTMAP,ORREM)
+22 IF '$DATA(ORLSTMAP)
Begin DoDot:1
+23 WRITE !,"This entry is not mapped to any Team Lists.",!
+24 HANG 5
End DoDot:1
QUIT
+25 ;
+26 SET ORREMNM=$PIECE($GET(^PXRM(810.4,+ORREM,0)),U,1)
+27 ;
+28 KILL DIR,Y,X
+29 SET DIR(0)="Y"
+30 SET DIR("B")="NO"
+31 SET DIR("A")="Do you want to run "_ORREMNM_" now"
+32 DO ^DIR
+33 IF $DATA(DIRUT)
QUIT
+34 IF Y'=1
QUIT
+35 ;
+36 DO EN^XPAR("SYS","ORLP TEAM LIST FROM REM LAST","`"_ORREM,"@")
+37 SET ORVAR="ORREM;ORLSTMAP("
+38 SET ORARR("ZTDTH")=$HOROLOG
+39 SET ORTSK=$$NODEV^XUTMDEVQ("ENONE^ORLPREM","Run List Rule to Update Team List",ORVAR,.ORARR,0)
+40 WRITE !!,"Task #"_ORTSK_" queued.",!!
+41 HANG 2
+42 ;
+43 DO REFRESH
+44 ;
+45 QUIT
+46 ;
REFRESH ; Refresh List
+1 DO CLEAN^VALM10
+2 DO INIT
+3 QUIT
+4 ;
ENPAR ; Configure paramaters - loop till exit
+1 ;
+2 NEW ORPAR
+3 ;
+4 SET ORPAR=""
+5 FOR
Begin DoDot:1
+6 SET ORPAR=$$PAR
End DoDot:1
if ORPAR<0
QUIT
+7 ;
+8 QUIT
+9 ;
PAR(ORREM) ; configure paramaters. Add/Edit Entry
+1 ;
+2 NEW ORFILTER,ORFLAG,ORFREQ,OROVER,ORPARDEF,ORPARS,ORREQ
+3 ;
+4 IF '$GET(ORREM)
SET ORREM=$$SELREM
+5 IF ORREM<1
QUIT -1
+6 ;
+7 SET ORPARDEF=$$GETPARS(.ORPARS,ORREM)
+8 ;
+9 SET ORFILTER=0
+10 IF ORPARDEF=2
SET ORFILTER=1
+11 ; ask if nothing already set for list rule
+12 IF ORPARDEF<1
SET ORFILTER=$$SELFLTR
+13 IF ORFILTER<0!(ORFILTER="")
QUIT ORFILTER
+14 ;
+15 SET ORFLAG=1
+16 WRITE !
+17 ;
+18 IF ORFILTER
Begin DoDot:1
+19 WRITE !!,?3,">> First, you will need to select a team list to be used in cases"
+20 WRITE !,?3,">> where it cannot be determined which division a patient belongs to."
+21 WRITE !
+22 SET ORREQ=0
+23 IF ORPARDEF=2
SET ORREQ=1
+24 SET ORFLAG=$$PARSYS(ORREM,.ORPARS,ORREQ)
+25 IF ORFLAG<1
QUIT
+26 ;
+27 WRITE !!,?3,">> Now, you can select the team lists to be used for each division."
+28 SET ORFLAG=$$PARDIV(ORREM,.ORPARS)
End DoDot:1
+29 ;
+30 IF 'ORFILTER
SET ORFLAG=$$PARSYS(ORREM,.ORPARS)
+31 ;
+32 KILL ORPARS
+33 SET ORPARDEF=$$GETPARS(.ORPARS,ORREM)
+34 IF ORPARDEF
Begin DoDot:1
+35 SET ORFREQ=$$SELFREQ(ORREM)
+36 IF ORFREQ<0
SET ORFLAG=-1
QUIT
+37 SET OROVER=$$SELOVER(ORREM)
+38 IF OROVER<0
SET ORFLAG=-1
QUIT
+39 WRITE !
End DoDot:1
+40 ;I 'ORPARDEF D
+41 ;. D EN^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM,"@",.ORERR)
+42 ;
+43 QUIT ORFLAG
+44 ;
PARDIV(ORREM,ORPARS) ; Configure ORLP TEAM LIST FROM REM at the div level
+1 ;
+2 NEW ORDIV,ORERR,ORFLAG,ORLST,ORLSTSCR
+3 ;
+4 SET ORFLAG=1
+5 SET ORDIV=""
+6 SET ORLST=""
+7 DO LSTSCR(.ORLSTSCR,ORREM)
+8 ;
+9 FOR
Begin DoDot:1
+10 WRITE !
+11 SET ORDIV=$$SELDIV
+12 IF ORDIV<1
QUIT
+13 SET ORLST=$GET(ORPARS(ORDIV))
+14 SET ORLST=$$SELLST(ORLST,.ORLSTSCR)
+15 IF $GET(ORPARS(ORDIV))
IF 'ORLST
SET ORLST="@"
+16 IF ORLST<1
IF ORLST'="@"
QUIT
+17 DO EN^XPAR(ORDIV_";DIC(4,","ORLP TEAM LIST FROM REM","`"_ORREM,$SELECT(ORLST="@":"",1:"`")_ORLST,.ORERR)
+18 IF $PIECE($GET(ORERR),U,2)'=""
WRITE !,"Error: "_$PIECE(ORERR,U,2),!
End DoDot:1
if ((ORDIV<1)!(ORLST<1))
QUIT
+19 ;
+20 IF ((ORDIV<0)!(ORLST<0))
SET ORFLAG=-1
+21 ;
+22 QUIT ORFLAG
+23 ;
PARSYS(ORREM,ORPARS,ORREQ) ; Configure ORLP TEAM LIST FROM REM at the sys level
+1 ;
+2 NEW ORERR,ORFLAG,ORLST,ORLSTSCR
+3 ;
+4 SET ORFLAG=1
+5 DO LSTSCR(.ORLSTSCR,ORREM)
+6 ;
+7 SET ORLST=$GET(ORPARS("SYS"))
+8 SET ORLST=$$SELLST(ORLST,.ORLSTSCR,$GET(ORREQ))
+9 IF $GET(ORPARS("SYS"))
IF 'ORLST
SET ORLST="@"
+10 IF ORLST<1
IF ORLST'="@"
QUIT ORLST
+11 DO EN^XPAR("SYS","ORLP TEAM LIST FROM REM","`"_ORREM,$SELECT(ORLST="@":"",1:"`")_ORLST,.ORERR)
+12 IF $PIECE($GET(ORERR),U,2)'=""
WRITE !,"Error: "_$PIECE(ORERR,U,2),!
+13 ;
+14 IF ORLST<0
SET ORFLAG=-1
+15 ;
+16 QUIT ORFLAG
+17 ;
SELFLTR() ; Ask user if they want to filter by div
+1 ;
+2 NEW DIR,DIRUT,ORFILTER,X,Y
+3 ;
+4 WRITE !
+5 SET DIR(0)="YO"
+6 SET DIR("B")="NO"
+7 SET DIR("A")="Do you want to filter patients by Division"
+8 SET DIR("?",1)="If you want to filter the patients by division, for example, to have patients"
+9 SET DIR("?",2)="from division A added to one team list and patients from division B"
+10 SET DIR("?")="added to another team list, enter YES."
+11 DO ^DIR
+12 IF $DATA(DIRUT)
QUIT -1
+13 SET ORFILTER=Y
+14 WRITE !
+15 ;
+16 QUIT ORFILTER
+17 ;
SELDIV() ; prompt for div
+1 ;
+2 NEW DIC,DINUM,DLAYGO,DTOUT,DUOUT,ORDIV,X,Y
+3 ;
+4 SET ORDIV=""
+5 ;
+6 SET DIC=4
+7 SET DIC(0)="AEMNQO"
+8 SET DIC("A")="Select DIVISION: "
+9 DO ^DIC
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+11 SET ORDIV=+Y
+12 IF ORDIV<0
SET ORDIV=""
+13 ;
+14 QUIT ORDIV
+15 ;
SELREM() ; prompt for reminder list rule
+1 ;
+2 NEW DIC,DINUM,DLAYGO,DTOUT,DUOUT,ORREM,X,Y
+3 ;
+4 SET DIC=810.4
+5 SET DIC(0)="AEMNQO"
+6 SET DIC("S")="I $P(^(0),U,3)=3"
+7 DO ^DIC
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+9 SET ORREM=+Y
+10 IF ORREM<0
SET ORREM=""
+11 ;
+12 QUIT ORREM
+13 ;
SELLST(ORDEF,ORLSTSCR,ORREQ) ; prompt for OE/RR List
+1 ;
+2 ; ORDEF = Default 100.21 Entry
+3 ; ORLSTSCR = don't allow user to select entries in this array
+4 ; ORREQ = Should user be forced to select an entry
+5 ;
+6 NEW DIR,DIRUT,DTOUT,DUOUT,ORLST,X,Y
+7 ;
+8 SET DIR(0)="PO^100.21:QEM"
+9 IF $GET(ORREQ)
SET DIR(0)="P^100.21:QEM"
+10 IF $GET(ORDEF)
SET DIR("B")=$PIECE($GET(^OR(100.21,ORDEF,0)),U,1)
+11 SET DIR("S")="I '$D(ORLSTSCR(Y))"
+12 DO ^DIR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+14 SET ORLST=+Y
+15 IF ORLST<0
SET ORLST=""
+16 ;
+17 QUIT ORLST
+18 ;
LSTSCR(ORRET,ORREM) ; return array of 100.21 entries that should be used for screening
+1 ;
+2 NEW ORENT,ORLST,ORPARS,ORREM2
+3 ;
+4 DO ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM")
+5 SET ORENT=""
+6 FOR
SET ORENT=$ORDER(ORPARS(ORENT))
if ORENT=""
QUIT
Begin DoDot:1
+7 SET ORREM2=0
+8 FOR
SET ORREM2=$ORDER(ORPARS(ORENT,ORREM2))
if 'ORREM2
QUIT
Begin DoDot:2
+9 IF ORREM=ORREM2
QUIT
+10 SET ORLST=$GET(ORPARS(ORENT,ORREM2))
+11 IF ORLST=""
QUIT
+12 IF '$DATA(^OR(100.21,ORLST))
QUIT
+13 SET ORRET(ORLST)=""
End DoDot:2
End DoDot:1
+14 ;
+15 QUIT
+16 ;
SELFREQ(ORREM) ; Configure ORLP TEAM LIST FROM REM FREQ
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,ORFREQ,ORERR,X,Y
+3 ;
+4 SET ORFREQ=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
+5 ;
+6 WRITE !
+7 ;
+8 SET DIR(0)="NO^1:365:0"
+9 IF ORFREQ>0
SET DIR("B")=ORFREQ
+10 SET DIR("A")="Enter the frequency (in days) the team list should be updated"
+11 SET DIR("?",1)="Enter how often (in days) the reminder list rule should run"
+12 SET DIR("?")="in order to update the team list"
+13 DO ^DIR
+14 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+15 SET ORFREQ=Y
+16 ;
+17 IF ORFREQ>0!(ORFREQ="")
Begin DoDot:1
+18 DO EN^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM,$SELECT(ORFREQ="":"@",1:ORFREQ),.ORERR)
+19 ;I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
End DoDot:1
+20 ;
+21 QUIT ORFREQ
+22 ;
SELOVER(ORREM) ; Configure ORLP TEAM LIST FROM REM OVER
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,OROVER,ORERR,X,Y
+3 ;
+4 SET OROVER=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
+5 ;
+6 WRITE !
+7 ;
+8 SET DIR(0)="YO"
+9 SET DIR("B")="YES"
+10 IF OROVER'=""
SET DIR("B")=$SELECT(OROVER=0:"NO",1:"YES")
+11 SET DIR("A")="Should the Rem Patient List be overwritten when updating a Team List"
+12 SET DIR("?",1)="Enter 'NO' if you want the previous Reminder Patient List not to be overwritten"
+13 SET DIR("?")="when updating a Team List"
+14 DO ^DIR
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+16 SET OROVER=Y
+17 ;
+18 IF OROVER=1!(OROVER=0)!(OROVER="")
Begin DoDot:1
+19 DO EN^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM,$SELECT(OROVER="":"@",1:OROVER),.ORERR)
+20 ;I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
End DoDot:1
+21 ;
+22 QUIT OROVER
+23 ;
GETPARS(ORRET,ORREM) ; Get team maapping for one list rule
+1 ;
+2 NEW ORLST,ORPAR,ORPARDEF,ORPARS
+3 ;
+4 SET ORPARDEF=0
+5 ;
+6 DO ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM","`"_ORREM)
+7 SET ORPAR=""
+8 FOR
SET ORPAR=$ORDER(ORPARS(ORPAR))
if ORPAR=""
QUIT
Begin DoDot:1
+9 SET ORLST=$GET(ORPARS(ORPAR,ORREM))
+10 IF ORLST=""
QUIT
+11 IF '$DATA(^OR(100.21,ORLST))
QUIT
+12 IF ORPAR[";DIC(4.2,"
Begin DoDot:2
+13 SET ORRET("SYS")=ORLST
+14 IF ORPARDEF'=2
SET ORPARDEF=1
End DoDot:2
+15 IF ORPAR[";DIC(4,"
Begin DoDot:2
+16 SET ORRET(+ORPAR)=ORLST
+17 SET ORPARDEF=2
End DoDot:2
End DoDot:1
+18 ;
+19 QUIT ORPARDEF
+20 ;
GETAPARS(ORFORMAT) ; Get team maapping for all list rules
+1 ;
+2 NEW ORENT,ORENTNM,ORLST,ORLSTNM,ORPARS,ORREM,ORREMNM
+3 ;
+4 IF $GET(ORFORMAT)'="E"
SET ORFORMAT="I"
+5 ;
+6 DO ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM")
+7 SET ORENT=""
+8 FOR
SET ORENT=$ORDER(ORPARS(ORENT))
if ORENT=""
QUIT
Begin DoDot:1
+9 SET ORREM=0
+10 FOR
SET ORREM=$ORDER(ORPARS(ORENT,ORREM))
if 'ORREM
QUIT
Begin DoDot:2
+11 SET ORREMNM=$PIECE($GET(^PXRM(810.4,+ORREM,0)),U,1)
+12 ;TODO - delete this par
IF ORREMNM=""
QUIT
+13 SET ORLST=$GET(ORPARS(ORENT,ORREM))
+14 SET ORLSTNM=$PIECE($GET(^OR(100.21,+ORLST,0)),U,1)
+15 ;TODO - delete this par
IF ORLSTNM=""
QUIT
+16 IF ORFORMAT="E"
Begin DoDot:3
+17 SET ^TMP("ORLPREM",$JOB,ORREMNM)=ORREM
End DoDot:3
+18 SET ORENTNM=""
+19 IF ORENT[";DIC(4.2,"
Begin DoDot:3
+20 SET ORENTNM="SYS"
End DoDot:3
+21 IF ORENT[";DIC(4,"
Begin DoDot:3
+22 SET ORENTNM=+ORENT
End DoDot:3
+23 ;TODO - delete this par
IF ORENTNM=""
QUIT
+24 IF ORFORMAT="E"
Begin DoDot:3
+25 SET ^TMP("ORLPREM",$JOB,ORREMNM,ORENTNM)=ORLST_U_ORLSTNM
End DoDot:3
+26 IF ORFORMAT="I"
Begin DoDot:3
+27 SET ^TMP("ORLPREM",$JOB,ORREM,ORENTNM)=ORLST
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT
+30 ;
GETSCHED(ORREM) ;
+1 ;
+2 ; Returns: Last time the List rule was ran to update the OE/RR List
+3 ; ^ Frequency (in days) that it runs
+4 ; ^ Next scheduled run time
+5 ;
+6 NEW ORFREQ,ORLASTRUN,ORNEXTRUN,ORPARS,ORPARDEF,ORTASK,ORTASKDT
+7 ;
+8 SET ORLASTRUN=$$GETLAST(ORREM)
+9 SET ORFREQ=$$GETFREQ(ORREM)
+10 SET ORNEXTRUN=""
+11 SET ORTASK=$$GETTASK
+12 SET ORTASKDT=$PIECE(ORTASK,U,2)
+13 SET ORPARDEF=$$GETPARS(.ORPARS,ORREM)
+14 IF ORTASKDT
IF ORFREQ
IF ORPARDEF
Begin DoDot:1
+15 IF 'ORLASTRUN
Begin DoDot:2
+16 SET ORNEXTRUN=ORTASKDT
End DoDot:2
QUIT
+17 SET ORNEXTRUN=$PIECE(ORLASTRUN,".",1)_"."_$PIECE(ORTASKDT,".",2)
+18 SET ORNEXTRUN=$$FMADD^XLFDT(ORNEXTRUN,ORFREQ)
End DoDot:1
+19 ;
+20 QUIT ORLASTRUN_U_ORFREQ_U_ORNEXTRUN
+21 ;
GETLAST(ORREM) ; returns ORLP TEAM LIST FROM REM LAST par
+1 QUIT $$GET^XPAR("SYS","ORLP TEAM LIST FROM REM LAST","`"_ORREM)
+2 ;
GETFREQ(ORREM) ; returns ORLP TEAM LIST FROM REM FREQ par
+1 QUIT $$GET^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
+2 ;
GETOVER(ORREM) ; returns ORLP TEAM LIST FROM REM OVER par
+1 NEW OROVER
+2 SET OROVER=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
+3 IF OROVER'=0
SET OROVER=1
+4 QUIT OROVER
+5 ;
GETTASK() ;
+1 ;
+2 ; returns task number^scheduled time^reschedule freq^special queuing flag
+3 ; of ORLP TEAM LIST FROM REM task
+4 ;
+5 NEW ORLST,ORRET,ORX
+6 ;
+7 SET ORRET=""
+8 DO OPTSTAT^XUTMOPT("ORLP TEAM LIST FROM REM",.ORLST)
+9 SET ORX=$ORDER(ORLST(0))
+10 IF ORX
IF $PIECE($GET(ORLST(ORX)),U,1)'=""
Begin DoDot:1
+11 SET ORRET=$GET(ORLST(ORX))
End DoDot:1
+12 ;
+13 QUIT ORRET
+14 ;
LASTUPD(ORLST) ; Returns Last Updated D/T (100.21, 12.1) for a given list
+1 QUIT $PIECE($GET(^OR(100.21,+$GET(ORLST),12)),U,1)
