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

ORLPREM.m

Go to the documentation of this file. 
  1. ORLPREM ;ISP/LMT,AGP - CPRS Team List from a Reminder Patient List ;Apr 21, 2021@22:16:19
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,498**;Dec 17, 1997;Build 38
  1.  ;
  1.  ;
  1. ENTASK ;
  1.  ;
  1.  ; ZEXCEPT: ZTREQ
  1.  ;
  1.  N ORLISTDUE,ORLSTMAP,ORREM
  1.  ;
  1.  S ZTREQ="@"
  1.  ;
  1.  D GETDUE(.ORLISTDUE)
  1.  ;
  1.  S ORREM=0
  1.  F  S ORREM=$O(ORLISTDUE(ORREM)) Q:'ORREM  D
  1.  . M ORLSTMAP=ORLISTDUE(ORREM)
  1.  . D EN(ORREM,.ORLSTMAP)
  1.  ;
  1.  Q
  1.  ;
  1. ENONE ;
  1.  ;
  1.  ; ZEXCEPT: ORLSTMAP,ORREM,ZTREQ
  1.  S ZTREQ="@"
  1.  ;
  1.  D EN(ORREM,.ORLSTMAP)
  1.  Q
  1.  ;
  1. EN(ORREM,ORLSTMAP) ;
  1.  ;
  1.  N DFN,ORCNT,ORDIV,ORERR,ORFDA,ORIENS,ORLST,OROVER,ORPL,ORREMNM,ORSCRBYDIV,ORX
  1.  ;
  1.  S ORSCRBYDIV=0
  1.  S ORREMNM=$P($G(^PXRM(810.4,+ORREM,0)),U,1)
  1.  I ORREMNM="" Q
  1.  ;
  1.  I $O(ORLSTMAP("SYS"),-1) S ORSCRBYDIV=1
  1.  ;
  1.  ; Get Reminder Patient List
  1.  S OROVER=$$GETOVER^ORLPREML(ORREM)
  1.  D GETRMLST^ORBSMART(.ORPL,ORREMNM,OROVER,0)
  1.  ;
  1.  ; Set FDA array to populate 100.21
  1.  S ORCNT=0
  1.  S DFN=0
  1.  F  S DFN=$O(ORPL(DFN)) Q:'DFN  D
  1.  . S ORCNT=ORCNT+1
  1.  . I 'ORSCRBYDIV D
  1.  . . S ORLST=$G(ORLSTMAP("SYS"))
  1.  . . I 'ORLST Q
  1.  . . S ORIENS="+"_ORCNT_","_ORLST_","
  1.  . . S ORFDA(ORLST,100.2101,ORIENS,.01)=DFN_";DPT("
  1.  . I ORSCRBYDIV D
  1.  . . S ORDIV=$$GETDIV(DFN)
  1.  . . I ORDIV,$G(ORLSTMAP(ORDIV)) D
  1.  . . . S ORLST=ORLSTMAP(ORDIV)
  1.  . . . S ORIENS="+"_ORCNT_","_ORLST_","
  1.  . . . S ORFDA(ORLST,100.2101,ORIENS,.01)=DFN_";DPT("
  1.  . . I $G(ORLSTMAP("SYS")),'ORDIV D
  1.  . . . S ORLST=ORLSTMAP("SYS")
  1.  . . . S ORIENS="+"_ORCNT_","_ORLST_","
  1.  . . . S ORFDA(ORLST,100.2101,ORIENS,.01)=DFN_";DPT("
  1.  ;
  1.  S ORX=""
  1.  F  S ORX=$O(ORLSTMAP(ORX)) Q:ORX=""  D
  1.  . S ORLST=$G(ORLSTMAP(ORX))
  1.  . I 'ORLST Q
  1.  . D CLEAN^DILF
  1.  . ;
  1.  . L +^OR(100.21,ORLST):999
  1.  . D PRGLST(ORLST)
  1.  . ; p498 - in case there were no members on the list before and no members were added, force set 12.1
  1.  . S ORFDA(ORLST,100.21,ORLST_",",12.1)=$$NOW^XLFDT
  1.  . S ORFDA(ORLST,100.21,ORLST_",",12.2)=ORREM_";PXRM(810.4,"
  1.  . D UPDATE^DIE("","ORFDA("_ORLST_")")
  1.  . L -^OR(100.21,ORLST)
  1.  . ;
  1.  . I $D(^TMP("DIERR",$J)) D
  1.  . . D MSG^DIALOG("AE",.ORERR)
  1.  . . D SENDMSG("Error while filing patients to 100.21",.ORERR,ORREMNM,$P($G(^OR(100.21,ORLST,0)),U,1))
  1.  ;
  1.  D CLEAN^DILF
  1.  ;
  1.  D EN^XPAR("SYS","ORLP TEAM LIST FROM REM LAST","`"_ORREM,$$NOW^XLFDT)
  1.  ;
  1.  Q
  1.  ;
  1. PRGLST(ORLST) ; Clear existing list of patients
  1.  ;
  1.  N DA,DIK,ORMEM
  1.  ;
  1.  S ORMEM=0
  1.  F  S ORMEM=$O(^OR(100.21,ORLST,10,ORMEM)) Q:'ORMEM  D
  1.  . S DA=ORMEM
  1.  . S DA(1)=ORLST
  1.  . S DIK="^OR(100.21,"_DA(1)_",10,"
  1.  . D ^DIK
  1.  ;
  1.  Q
  1.  ;
  1. GETDIV(DFN) ;
  1.  ;
  1.  N ORDIV,ORDIVS,ORPCP,ORX
  1.  ;
  1.  S ORDIV=""
  1.  ;
  1.  ; PCP Institution
  1.  S ORPCP=+$$OUTPTPR^SDUTL3(DFN)
  1.  I ORPCP D
  1.  . S ORX=$$DIV4^XUSER(.ORDIVS,ORPCP)
  1.  . I 'ORX S ORDIV=$$KSP^XUPARAM("INST")
  1.  . I ORX D
  1.  . . S ORDIV=$O(ORDIVS(0))
  1.  . . I $O(ORDIVS(ORDIV)) S ORDIV=""  ;PCP assigned more than one DIV
  1.  ;
  1.  I ORDIV Q ORDIV
  1.  ;
  1.  ; Team's Institution
  1.  S ORDIV=$P($$INSTPCTM^SCAPMC(DFN),U,3)
  1.  I ORDIV Q ORDIV
  1.  ;
  1.  ; Preferred Facility
  1.  S ORDIV=$$PREF^DGENPTA(DFN)
  1.  ;
  1.  Q ORDIV
  1.  ;
  1. SENDMSG(ORERR,ORERRARR,ORREM,ORLST) ;
  1.  ;
  1.  ; ZEXCEPT: XQY0,ZTSK
  1.  N ORCNT,ORI,ORINSTR,ORLST,ORREM,ORSUB,ORTO
  1.  K ^TMP("ORMSG",$J)
  1.  ;
  1.  S ORCNT=0
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="There was an issue while updating the CPRS Team List from a"
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="Reminder Patient List."
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)=" "
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="Task ID: "_$G(ZTSK)
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="Option: "_$P($G(XQY0),U,2)
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="Error: "_$G(ORERR)
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="Reminder Patient List: "_$G(ORREM)
  1.  S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="OE/RR List: "_$G(ORLST)
  1.  ;
  1.  I $D(ORERRARR) D
  1.  . S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)=" "
  1.  . S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)="Error Details:"
  1.  . S ORI=0
  1.  . F  S ORI=$O(ORERRARR(ORI)) Q:'ORI  D
  1.  . . S ORCNT=ORCNT+1,^TMP("ORMSG",$J,ORCNT)=$G(ORERRARR(ORI))
  1.  ;
  1.  S ORSUB="Error Updating CPRS Team List"
  1.  S ORTO(DUZ)=""
  1.  S ORTO("G.OR CACS")=""
  1.  S ORINSTR("FROM")="CPRS TASKED JOB"
  1.  S ORINSTR("ADDR FLAGS")="R"
  1.  D SENDMSG^XMXAPI(DUZ,ORSUB,"^TMP(""ORMSG"",$J)",.ORTO,.ORINSTR,.ORMSGNUM)
  1.  ;
  1.  Q
  1.  ;
  1. GETDUE(ORLISTDUE) ;
  1.  ;
  1.  N ORFREQ,ORLASTRUN,ORNEXTRUN,ORREM
  1.  ;
  1.  K ^TMP("ORLPREM",$J)
  1.  ;
  1.  D GETAPARS^ORLPREML("I")
  1.  S ORREM=0
  1.  F  S ORREM=$O(^TMP("ORLPREM",$J,ORREM)) Q:'ORREM  D
  1.  . S ORLASTRUN=$$GETLAST^ORLPREML(ORREM)
  1.  . S ORFREQ=$$GETFREQ^ORLPREML(ORREM)
  1.  . ;
  1.  . I 'ORFREQ Q
  1.  . I 'ORLASTRUN D  Q
  1.  . . M ORLISTDUE(ORREM)=^TMP("ORLPREM",$J,ORREM)
  1.  . ;
  1.  . S ORNEXTRUN=$$FMADD^XLFDT($P(ORLASTRUN,".",1),ORFREQ)
  1.  . I ORNEXTRUN=DT!(ORNEXTRUN<DT) D
  1.  . . M ORLISTDUE(ORREM)=^TMP("ORLPREM",$J,ORREM)
  1.  ;
  1.  K ^TMP("ORLPREM",$J)
  1.  ;
  1.  Q
  1.  ;