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

ORLPREML.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. EN ; -- main entry point for ORLP TEAM LIST FROM REM
  1. D EN^VALM("ORLP TEAM LIST FROM REM")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. ;
  1. ; ZEXCEPT: VALMHDR
  1. N ORTASK
  1. ;
  1. S ORTASK=$$GETTASK
  1. I ORTASK="" D Q
  1. . S VALMHDR(1)=" << Option ORLP TEAM LIST FROM REM is not scheduled in TaskMan! >>"
  1. ;
  1. S VALMHDR(1)=" << Option ORLP TEAM LIST FROM REM is next scheduled to run: "_$$FMTE^XLFDT($P(ORTASK,U,2),"2M")_". >>"
  1. ;
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. ;
  1. ; ZEXCEPT: VALMAR,VALMCNT
  1. N ORCNT,ORDIV,ORENT,ORENTCNT,ORENTNM,ORFREQ,ORLASTRUN,ORLASTUPD,ORLINE,ORLINEVAR,ORLST
  1. N ORLSTNM,ORNEXTRUN,ORNODE,OROVER,ORREM,ORREMNM
  1. ;
  1. K ^TMP("ORLPREM",$J)
  1. K ^TMP("ORLPREM-MAP",$J)
  1. ;
  1. D GETAPARS("E")
  1. ;
  1. S ORCNT=0
  1. S ORLINE=0
  1. ;
  1. I '$D(^TMP("ORLPREM",$J)) D
  1. . S ORLINE=ORLINE+1
  1. . S ORLINEVAR=""
  1. . S ORLINEVAR=$$SETFLD^VALM1(">> There are currently no mappings.",ORLINEVAR,"ERROR")
  1. . D SET^VALM10(ORLINE,ORLINEVAR)
  1. ;
  1. S ORREMNM=""
  1. F S ORREMNM=$O(^TMP("ORLPREM",$J,ORREMNM)) Q:ORREMNM="" D
  1. . S ORCNT=ORCNT+1
  1. . S ORREM=$G(^TMP("ORLPREM",$J,ORREMNM))
  1. . S ^TMP("ORLPREM-MAP",$J,ORCNT)=ORREM
  1. . S ORLASTRUN=$$GETLAST(ORREM)
  1. . S ORFREQ=$$GETFREQ(ORREM)
  1. . S OROVER=$$GETOVER(ORREM)
  1. . S OROVER=$S(OROVER=0:"NO",1:"YES")
  1. . ;
  1. . S ORENTCNT=0
  1. . S ORENT=""
  1. . F S ORENT=$O(^TMP("ORLPREM",$J,ORREMNM,ORENT)) Q:ORENT="" D
  1. . . S ORENTCNT=ORENTCNT+1
  1. . . S ORNODE=$G(^TMP("ORLPREM",$J,ORREMNM,ORENT))
  1. . . S ORLST=$P(ORNODE,U,1)
  1. . . S ORLSTNM=$P(ORNODE,U,2)
  1. . . I ORENT="SYS",ORENTCNT=1 S ORDIV="All"
  1. . . I ORENT="SYS",ORENTCNT'=1 S ORDIV="Catch-All"
  1. . . I ORENT S ORDIV=$$STA^XUAF4(ORENT)
  1. . . ;
  1. . . S ORLINE=ORLINE+1
  1. . . S ORLINEVAR=""
  1. . . I ORENTCNT=1 D
  1. . . . S ORLINEVAR=$$SETFLD^VALM1(ORCNT,ORLINEVAR,"NUM")
  1. . . . S ORLINEVAR=$$SETFLD^VALM1(ORREMNM,ORLINEVAR,"REM")
  1. . . . S ORLINEVAR=$$SETFLD^VALM1($$FMTE^XLFDT(ORLASTRUN,"2M"),ORLINEVAR,"LASTRUN")
  1. . . . S ORLINEVAR=$$SETFLD^VALM1(ORFREQ_$S(ORFREQ:"D",1:""),ORLINEVAR,"FREQ")
  1. . . ;
  1. . . S ORLINEVAR=$$SETFLD^VALM1(ORDIV,ORLINEVAR,"DIV")
  1. . . S ORLINEVAR=$$SETFLD^VALM1(ORLSTNM,ORLINEVAR,"LIST")
  1. . . S ORLASTUPD=$$LASTUPD(ORLST)
  1. . . S ORLASTUPD=$$FMTE^XLFDT(ORLASTUPD,"2M")
  1. . . S ORLINEVAR=$$SETFLD^VALM1(ORLASTUPD,ORLINEVAR,"LASTUPD")
  1. . . I ORENTCNT=1 D
  1. . . . S ORNEXTRUN=$P($$GETSCHED(ORREM),U,3)
  1. . . . I ORNEXTRUN S ORNEXTRUN=$$FMTE^XLFDT(ORNEXTRUN,"2M")
  1. . . . S ORLINEVAR=$$SETFLD^VALM1(ORNEXTRUN,ORLINEVAR,"NEXTRUN")
  1. . . . S ORLINEVAR=$$SETFLD^VALM1(OROVER,ORLINEVAR,"OVER")
  1. . . D SET^VALM10(ORLINE,ORLINEVAR,ORCNT)
  1. ;
  1. S VALMCNT=ORLINE
  1. ;
  1. K ^TMP("ORLPREM",$J)
  1. ;
  1. Q
  1. ;
  1. HELP ; -- help code
  1. N X
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D CLEAN^VALM10
  1. K ^TMP("ORLPREM-MAP",$J)
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. KEYS ;
  1. ;
  1. ; ZEXCEPT: XQORM
  1. N ORI,ORPROT
  1. ;
  1. K XQORM("KEY") ;TODO - IS THIS NECESSARY?
  1. S ORPROT=$O(^ORD(101,"B","ORLPREM EDIT ENTRY",0))
  1. I 'ORPROT Q
  1. ;
  1. S ORI=0
  1. F S ORI=$O(^TMP("ORLPREM-MAP",$J,ORI)) Q:'ORI D
  1. . S XQORM("KEY",ORI)=ORPROT_"^1"
  1. ;
  1. Q
  1. ;
  1. SELECT(ORACTION) ;
  1. ;
  1. ; ZEXCEPT: XQORNOD
  1. N DIR,DIRUT,ORREM,X,Y
  1. ;
  1. D FULL^VALM1
  1. ;
  1. I '$O(^TMP("ORLPREM-MAP",$J,0)) D Q 0
  1. . W !,"There are no items to "_ORACTION_".",!
  1. . H 5
  1. ;
  1. S Y=+$P(XQORNOD(0),"^",3)
  1. ;
  1. I 'Y D
  1. . S DIR(0)="NO^1:"_$O(^TMP("ORLPREM-MAP",$J,""),-1)_":0"
  1. . S DIR("A")="Select Entry"
  1. . D ^DIR
  1. I $D(DIRUT) Q 0
  1. I Y'>0 Q 0
  1. ;
  1. S ORREM=$G(^TMP("ORLPREM-MAP",$J,Y))
  1. I 'ORREM D Q 0
  1. . W !,"This entry does not have a list rule mapping to "_ORACTION_".",!
  1. . H 5
  1. ;
  1. Q ORREM
  1. ;
  1. ADDENT ; Add an Entry
  1. ;
  1. D FULL^VALM1
  1. ;
  1. D PAR
  1. ;
  1. ;I $G(VALMAR)'="" K @VALMAR
  1. D REFRESH
  1. ;
  1. Q
  1. ;
  1. EDITENT ; Edit an Entry
  1. ;
  1. N ORREM
  1. ;
  1. S ORREM=$$SELECT("edit")
  1. I 'ORREM Q
  1. ;
  1. D PAR(ORREM)
  1. ;
  1. D REFRESH
  1. ;
  1. Q
  1. ;
  1. DELENT ; Delete an Entry
  1. ;
  1. ; ZEXCEPT: XQORNOD
  1. N DIR,DIRUT,ORENT,ORLST,ORREM,X,Y
  1. ;
  1. S ORREM=$$SELECT("delete")
  1. I 'ORREM Q
  1. ;
  1. S DIR(0)="Y"
  1. S DIR("A")="Are you sure you want to delete the mappings for "_$P($G(^PXRM(810.4,+ORREM,0)),U,1)
  1. S DIR("?",1)="If you select 'Yes', it will delete the team list mappings and defined"
  1. S DIR("?")="frequency for this reminder list rule."
  1. S DIR("B")="NO"
  1. D ^DIR
  1. I $G(DIRUT)!(Y'=1) Q
  1. ;
  1. D DEL^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
  1. D DEL^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
  1. ;
  1. D GETPARS(.ORLST,ORREM)
  1. S ORENT=""
  1. F S ORENT=$O(ORLST(ORENT)) Q:ORENT="" D
  1. . I ORENT="SYS" D Q
  1. . . D DEL^XPAR("SYS","ORLP TEAM LIST FROM REM","`"_ORREM)
  1. . I ORENT D Q
  1. . . D DEL^XPAR(ORENT_";DIC(4,","ORLP TEAM LIST FROM REM","`"_ORREM)
  1. ;
  1. D REFRESH
  1. ;
  1. Q
  1. ;
  1. RUNNOW ; Run one of the List Rules now
  1. ;
  1. N DIR,DIRUT,ORARR,ORLSTMAP,ORREM,ORREMNM,ORTSK,ORVAR,X,Y
  1. ;
  1. D FULL^VALM1
  1. ;
  1. I '$O(^TMP("ORLPREM-MAP",$J,0)) D Q
  1. . W !,"There are no items to select from.",!
  1. . H 5
  1. ;
  1. S DIR(0)="NO^1:"_$O(^TMP("ORLPREM-MAP",$J,""),-1)_":0"
  1. S DIR("A")="Select Entry"
  1. D ^DIR
  1. I $D(DIRUT) Q
  1. I Y'>0 Q
  1. ;
  1. S ORREM=$G(^TMP("ORLPREM-MAP",$J,Y))
  1. I 'ORREM D Q
  1. . W !,"This entry does not have a list rule mapping to run.",!
  1. . H 5
  1. ;
  1. D GETPARS^ORLPREML(.ORLSTMAP,ORREM)
  1. I '$D(ORLSTMAP) D Q
  1. . W !,"This entry is not mapped to any Team Lists.",!
  1. . H 5
  1. ;
  1. S ORREMNM=$P($G(^PXRM(810.4,+ORREM,0)),U,1)
  1. ;
  1. K DIR,Y,X
  1. S DIR(0)="Y"
  1. S DIR("B")="NO"
  1. S DIR("A")="Do you want to run "_ORREMNM_" now"
  1. D ^DIR
  1. I $D(DIRUT) Q
  1. I Y'=1 Q
  1. ;
  1. D EN^XPAR("SYS","ORLP TEAM LIST FROM REM LAST","`"_ORREM,"@")
  1. S ORVAR="ORREM;ORLSTMAP("
  1. S ORARR("ZTDTH")=$H
  1. S ORTSK=$$NODEV^XUTMDEVQ("ENONE^ORLPREM","Run List Rule to Update Team List",ORVAR,.ORARR,0)
  1. W !!,"Task #"_ORTSK_" queued.",!!
  1. H 2
  1. ;
  1. D REFRESH
  1. ;
  1. Q
  1. ;
  1. REFRESH ; Refresh List
  1. D CLEAN^VALM10
  1. D INIT
  1. Q
  1. ;
  1. ENPAR ; Configure paramaters - loop till exit
  1. ;
  1. N ORPAR
  1. ;
  1. S ORPAR=""
  1. F D Q:ORPAR<0
  1. . S ORPAR=$$PAR
  1. ;
  1. Q
  1. ;
  1. PAR(ORREM) ; configure paramaters. Add/Edit Entry
  1. ;
  1. N ORFILTER,ORFLAG,ORFREQ,OROVER,ORPARDEF,ORPARS,ORREQ
  1. ;
  1. I '$G(ORREM) S ORREM=$$SELREM
  1. I ORREM<1 Q -1
  1. ;
  1. S ORPARDEF=$$GETPARS(.ORPARS,ORREM)
  1. ;
  1. S ORFILTER=0
  1. I ORPARDEF=2 S ORFILTER=1
  1. ; ask if nothing already set for list rule
  1. I ORPARDEF<1 S ORFILTER=$$SELFLTR
  1. I ORFILTER<0!(ORFILTER="") Q ORFILTER
  1. ;
  1. S ORFLAG=1
  1. W !
  1. ;
  1. I ORFILTER D
  1. . W !!,?3,">> First, you will need to select a team list to be used in cases"
  1. . W !,?3,">> where it cannot be determined which division a patient belongs to."
  1. . W !
  1. . S ORREQ=0
  1. . I ORPARDEF=2 S ORREQ=1
  1. . S ORFLAG=$$PARSYS(ORREM,.ORPARS,ORREQ)
  1. . I ORFLAG<1 Q
  1. . ;
  1. . W !!,?3,">> Now, you can select the team lists to be used for each division."
  1. . S ORFLAG=$$PARDIV(ORREM,.ORPARS)
  1. ;
  1. I 'ORFILTER S ORFLAG=$$PARSYS(ORREM,.ORPARS)
  1. ;
  1. K ORPARS
  1. S ORPARDEF=$$GETPARS(.ORPARS,ORREM)
  1. I ORPARDEF D
  1. . S ORFREQ=$$SELFREQ(ORREM)
  1. . I ORFREQ<0 S ORFLAG=-1 Q
  1. . S OROVER=$$SELOVER(ORREM)
  1. . I OROVER<0 S ORFLAG=-1 Q
  1. . W !
  1. ;I 'ORPARDEF D
  1. ;. D EN^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM,"@",.ORERR)
  1. ;
  1. Q ORFLAG
  1. ;
  1. PARDIV(ORREM,ORPARS) ; Configure ORLP TEAM LIST FROM REM at the div level
  1. ;
  1. N ORDIV,ORERR,ORFLAG,ORLST,ORLSTSCR
  1. ;
  1. S ORFLAG=1
  1. S ORDIV=""
  1. S ORLST=""
  1. D LSTSCR(.ORLSTSCR,ORREM)
  1. ;
  1. F D Q:((ORDIV<1)!(ORLST<1))
  1. . W !
  1. . S ORDIV=$$SELDIV
  1. . I ORDIV<1 Q
  1. . S ORLST=$G(ORPARS(ORDIV))
  1. . S ORLST=$$SELLST(ORLST,.ORLSTSCR)
  1. . I $G(ORPARS(ORDIV)),'ORLST S ORLST="@"
  1. . I ORLST<1,ORLST'="@" Q
  1. . D EN^XPAR(ORDIV_";DIC(4,","ORLP TEAM LIST FROM REM","`"_ORREM,$S(ORLST="@":"",1:"`")_ORLST,.ORERR)
  1. . I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
  1. ;
  1. I ((ORDIV<0)!(ORLST<0)) S ORFLAG=-1
  1. ;
  1. Q ORFLAG
  1. ;
  1. PARSYS(ORREM,ORPARS,ORREQ) ; Configure ORLP TEAM LIST FROM REM at the sys level
  1. ;
  1. N ORERR,ORFLAG,ORLST,ORLSTSCR
  1. ;
  1. S ORFLAG=1
  1. D LSTSCR(.ORLSTSCR,ORREM)
  1. ;
  1. S ORLST=$G(ORPARS("SYS"))
  1. S ORLST=$$SELLST(ORLST,.ORLSTSCR,$G(ORREQ))
  1. I $G(ORPARS("SYS")),'ORLST S ORLST="@"
  1. I ORLST<1,ORLST'="@" Q ORLST
  1. D EN^XPAR("SYS","ORLP TEAM LIST FROM REM","`"_ORREM,$S(ORLST="@":"",1:"`")_ORLST,.ORERR)
  1. I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
  1. ;
  1. I ORLST<0 S ORFLAG=-1
  1. ;
  1. Q ORFLAG
  1. ;
  1. SELFLTR() ; Ask user if they want to filter by div
  1. ;
  1. N DIR,DIRUT,ORFILTER,X,Y
  1. ;
  1. W !
  1. S DIR(0)="YO"
  1. S DIR("B")="NO"
  1. S DIR("A")="Do you want to filter patients by Division"
  1. S DIR("?",1)="If you want to filter the patients by division, for example, to have patients"
  1. S DIR("?",2)="from division A added to one team list and patients from division B"
  1. S DIR("?")="added to another team list, enter YES."
  1. D ^DIR
  1. I $D(DIRUT) Q -1
  1. S ORFILTER=Y
  1. W !
  1. ;
  1. Q ORFILTER
  1. ;
  1. SELDIV() ; prompt for div
  1. ;
  1. N DIC,DINUM,DLAYGO,DTOUT,DUOUT,ORDIV,X,Y
  1. ;
  1. S ORDIV=""
  1. ;
  1. S DIC=4
  1. S DIC(0)="AEMNQO"
  1. S DIC("A")="Select DIVISION: "
  1. D ^DIC
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. S ORDIV=+Y
  1. I ORDIV<0 S ORDIV=""
  1. ;
  1. Q ORDIV
  1. ;
  1. SELREM() ; prompt for reminder list rule
  1. ;
  1. N DIC,DINUM,DLAYGO,DTOUT,DUOUT,ORREM,X,Y
  1. ;
  1. S DIC=810.4
  1. S DIC(0)="AEMNQO"
  1. S DIC("S")="I $P(^(0),U,3)=3"
  1. D ^DIC
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. S ORREM=+Y
  1. I ORREM<0 S ORREM=""
  1. ;
  1. Q ORREM
  1. ;
  1. SELLST(ORDEF,ORLSTSCR,ORREQ) ; prompt for OE/RR List
  1. ;
  1. ; ORDEF = Default 100.21 Entry
  1. ; ORLSTSCR = don't allow user to select entries in this array
  1. ; ORREQ = Should user be forced to select an entry
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,ORLST,X,Y
  1. ;
  1. S DIR(0)="PO^100.21:QEM"
  1. I $G(ORREQ) S DIR(0)="P^100.21:QEM"
  1. I $G(ORDEF) S DIR("B")=$P($G(^OR(100.21,ORDEF,0)),U,1)
  1. S DIR("S")="I '$D(ORLSTSCR(Y))"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. S ORLST=+Y
  1. I ORLST<0 S ORLST=""
  1. ;
  1. Q ORLST
  1. ;
  1. LSTSCR(ORRET,ORREM) ; return array of 100.21 entries that should be used for screening
  1. ;
  1. N ORENT,ORLST,ORPARS,ORREM2
  1. ;
  1. D ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM")
  1. S ORENT=""
  1. F S ORENT=$O(ORPARS(ORENT)) Q:ORENT="" D
  1. . S ORREM2=0
  1. . F S ORREM2=$O(ORPARS(ORENT,ORREM2)) Q:'ORREM2 D
  1. . . I ORREM=ORREM2 Q
  1. . . S ORLST=$G(ORPARS(ORENT,ORREM2))
  1. . . I ORLST="" Q
  1. . . I '$D(^OR(100.21,ORLST)) Q
  1. . . S ORRET(ORLST)=""
  1. ;
  1. Q
  1. ;
  1. SELFREQ(ORREM) ; Configure ORLP TEAM LIST FROM REM FREQ
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,ORFREQ,ORERR,X,Y
  1. ;
  1. S ORFREQ=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
  1. ;
  1. W !
  1. ;
  1. S DIR(0)="NO^1:365:0"
  1. I ORFREQ>0 S DIR("B")=ORFREQ
  1. S DIR("A")="Enter the frequency (in days) the team list should be updated"
  1. S DIR("?",1)="Enter how often (in days) the reminder list rule should run"
  1. S DIR("?")="in order to update the team list"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. S ORFREQ=Y
  1. ;
  1. I ORFREQ>0!(ORFREQ="") D
  1. . D EN^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM,$S(ORFREQ="":"@",1:ORFREQ),.ORERR)
  1. . ;I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
  1. ;
  1. Q ORFREQ
  1. ;
  1. SELOVER(ORREM) ; Configure ORLP TEAM LIST FROM REM OVER
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,OROVER,ORERR,X,Y
  1. ;
  1. S OROVER=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
  1. ;
  1. W !
  1. ;
  1. S DIR(0)="YO"
  1. S DIR("B")="YES"
  1. I OROVER'="" S DIR("B")=$S(OROVER=0:"NO",1:"YES")
  1. S DIR("A")="Should the Rem Patient List be overwritten when updating a Team List"
  1. S DIR("?",1)="Enter 'NO' if you want the previous Reminder Patient List not to be overwritten"
  1. S DIR("?")="when updating a Team List"
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. S OROVER=Y
  1. ;
  1. I OROVER=1!(OROVER=0)!(OROVER="") D
  1. . D EN^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM,$S(OROVER="":"@",1:OROVER),.ORERR)
  1. . ;I $P($G(ORERR),U,2)'="" W !,"Error: "_$P(ORERR,U,2),!
  1. ;
  1. Q OROVER
  1. ;
  1. GETPARS(ORRET,ORREM) ; Get team maapping for one list rule
  1. ;
  1. N ORLST,ORPAR,ORPARDEF,ORPARS
  1. ;
  1. S ORPARDEF=0
  1. ;
  1. D ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM","`"_ORREM)
  1. S ORPAR=""
  1. F S ORPAR=$O(ORPARS(ORPAR)) Q:ORPAR="" D
  1. . S ORLST=$G(ORPARS(ORPAR,ORREM))
  1. . I ORLST="" Q
  1. . I '$D(^OR(100.21,ORLST)) Q
  1. . I ORPAR[";DIC(4.2," D
  1. . . S ORRET("SYS")=ORLST
  1. . . I ORPARDEF'=2 S ORPARDEF=1
  1. . I ORPAR[";DIC(4," D
  1. . . S ORRET(+ORPAR)=ORLST
  1. . . S ORPARDEF=2
  1. ;
  1. Q ORPARDEF
  1. ;
  1. GETAPARS(ORFORMAT) ; Get team maapping for all list rules
  1. ;
  1. N ORENT,ORENTNM,ORLST,ORLSTNM,ORPARS,ORREM,ORREMNM
  1. ;
  1. I $G(ORFORMAT)'="E" S ORFORMAT="I"
  1. ;
  1. D ENVAL^XPAR(.ORPARS,"ORLP TEAM LIST FROM REM")
  1. S ORENT=""
  1. F S ORENT=$O(ORPARS(ORENT)) Q:ORENT="" D
  1. . S ORREM=0
  1. . F S ORREM=$O(ORPARS(ORENT,ORREM)) Q:'ORREM D
  1. . . S ORREMNM=$P($G(^PXRM(810.4,+ORREM,0)),U,1)
  1. . . I ORREMNM="" Q ;TODO - delete this par
  1. . . S ORLST=$G(ORPARS(ORENT,ORREM))
  1. . . S ORLSTNM=$P($G(^OR(100.21,+ORLST,0)),U,1)
  1. . . I ORLSTNM="" Q ;TODO - delete this par
  1. . . I ORFORMAT="E" D
  1. . . . S ^TMP("ORLPREM",$J,ORREMNM)=ORREM
  1. . . S ORENTNM=""
  1. . . I ORENT[";DIC(4.2," D
  1. . . . S ORENTNM="SYS"
  1. . . I ORENT[";DIC(4," D
  1. . . . S ORENTNM=+ORENT
  1. . . I ORENTNM="" Q ;TODO - delete this par
  1. . . I ORFORMAT="E" D
  1. . . . S ^TMP("ORLPREM",$J,ORREMNM,ORENTNM)=ORLST_U_ORLSTNM
  1. . . I ORFORMAT="I" D
  1. . . . S ^TMP("ORLPREM",$J,ORREM,ORENTNM)=ORLST
  1. ;
  1. Q
  1. ;
  1. GETSCHED(ORREM) ;
  1. ;
  1. ; Returns: Last time the List rule was ran to update the OE/RR List
  1. ; ^ Frequency (in days) that it runs
  1. ; ^ Next scheduled run time
  1. ;
  1. N ORFREQ,ORLASTRUN,ORNEXTRUN,ORPARS,ORPARDEF,ORTASK,ORTASKDT
  1. ;
  1. S ORLASTRUN=$$GETLAST(ORREM)
  1. S ORFREQ=$$GETFREQ(ORREM)
  1. S ORNEXTRUN=""
  1. S ORTASK=$$GETTASK
  1. S ORTASKDT=$P(ORTASK,U,2)
  1. S ORPARDEF=$$GETPARS(.ORPARS,ORREM)
  1. I ORTASKDT,ORFREQ,ORPARDEF D
  1. . I 'ORLASTRUN D Q
  1. . . S ORNEXTRUN=ORTASKDT
  1. . S ORNEXTRUN=$P(ORLASTRUN,".",1)_"."_$P(ORTASKDT,".",2)
  1. . S ORNEXTRUN=$$FMADD^XLFDT(ORNEXTRUN,ORFREQ)
  1. ;
  1. Q ORLASTRUN_U_ORFREQ_U_ORNEXTRUN
  1. ;
  1. GETLAST(ORREM) ; returns ORLP TEAM LIST FROM REM LAST par
  1. Q $$GET^XPAR("SYS","ORLP TEAM LIST FROM REM LAST","`"_ORREM)
  1. ;
  1. GETFREQ(ORREM) ; returns ORLP TEAM LIST FROM REM FREQ par
  1. Q $$GET^XPAR("SYS","ORLP TEAM LIST FROM REM FREQ","`"_ORREM)
  1. ;
  1. GETOVER(ORREM) ; returns ORLP TEAM LIST FROM REM OVER par
  1. N OROVER
  1. S OROVER=$$GET^XPAR("SYS","ORLP TEAM LIST FROM REM OVER","`"_ORREM)
  1. I OROVER'=0 S OROVER=1
  1. Q OROVER
  1. ;
  1. GETTASK() ;
  1. ;
  1. ; returns task number^scheduled time^reschedule freq^special queuing flag
  1. ; of ORLP TEAM LIST FROM REM task
  1. ;
  1. N ORLST,ORRET,ORX
  1. ;
  1. S ORRET=""
  1. D OPTSTAT^XUTMOPT("ORLP TEAM LIST FROM REM",.ORLST)
  1. S ORX=$O(ORLST(0))
  1. I ORX,$P($G(ORLST(ORX)),U,1)'="" D
  1. . S ORRET=$G(ORLST(ORX))
  1. ;
  1. Q ORRET
  1. ;
  1. LASTUPD(ORLST) ; Returns Last Updated D/T (100.21, 12.1) for a given list
  1. Q $P($G(^OR(100.21,+$G(ORLST),12)),U,1)