- 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 Jan 18, 2025@03:32:44 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)