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

PXRMCVRL.m

Go to the documentation of this file. 
  1. PXRMCVRL ; SLC/JM/AGP - Reminder CPRS Code ;04/08/2019
  1.  ;;2.0;CLINICAL REMINDERS;**53,45**;Feb 04, 2005;Build 566
  1.  Q
  1.  ;
  1. NEWACTIV(ORY) ;Return true if Interactive Reminders are active
  1.  S ORY=0
  1.  I $T(APPL^PXRMRPCA)'="",+$G(DUZ) D
  1.  . N SRV
  1.  . S SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1.  . S ORY=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM GUI REMINDERS ACTIVE",1,"Q")
  1.  . I +ORY S ORY=1
  1.  . E  S ORY=0
  1.  Q
  1.  ;
  1. NEWCVOK(RESULT,USER) ; Returns status of 
  1.  N SRV,ERR,TMP
  1.  S RESULT=0,SRV=$$GET1^DIQ(200,USER,29,"I")
  1.  D GETLST^XPAR(.TMP,"USR.`"_USER_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORQQPX NEW REMINDER PARAMS","Q",.ERR)
  1.  I +TMP S RESULT=$P($G(TMP(1)),U,2)
  1.  Q
  1.  ;
  1. ADDNAME(ORX) ; Add Reminder or Category Name as 3rd piece
  1.  N CAT,IEN
  1.  S CAT=$E($P(ORX,U,2),2)
  1.  S IEN=$E($P(ORX,U,2),3,99)
  1.  I +IEN D
  1.  .I CAT="R" S $P(ORX,U,3)=$P($G(^PXD(811.9,IEN,0)),U,3)
  1.  .I CAT="C" S $P(ORX,U,3)=$P($G(^PXRMD(811.7,IEN,0)),U)
  1.  Q ORX
  1.  ;
  1. REMACCUM(RESULT,LVL,TYP,SORT,CLASS,USER) ; Accumulates ORTMP into ORY
  1.  ; Format of entries in ORQQPX COVER SHEET REMINDERS:
  1.  ;   L:Lock;R:Remove;N:Normal / C:Category;R:Reminder / Cat or Rem IEN
  1.  N IDX,I,J,K,M,FOUND,ORERR,ORTMP,FLAG,IEN
  1.  N FFLAG,FIEN,OUT,P2,ADD,DOADD,CODE
  1.  I LVL="CLASS" D  I 1
  1.  .N ORLST,ORCLS,ORCLSPRM,ORWP
  1.  .S ORCLSPRM="ORQQPX COVER SHEET REM CLASSES"
  1.  .D GETLST^XPAR(.ORLST,"SYS",ORCLSPRM,"Q",.ORERR)
  1.  .S I=0,M=0,CLASS=$G(CLASS)
  1.  .F  S I=$O(ORLST(I)) Q:'I  D
  1.  ..S ORCLS=$P(ORLST(I),U,1)
  1.  ..I +CLASS S ADD=(ORCLS=+CLASS) I 1
  1.  ..E  S ADD=$$ISA^USRLM(USER,ORCLS,.ORERR)
  1.  ..I +ADD D
  1.  ...D GETWP^XPAR(.ORWP,"SYS",ORCLSPRM,ORCLS,.ORERR)
  1.  ...S K=0
  1.  ...F  S K=$O(ORWP(K)) Q:'K  D
  1.  ....S M=M+1
  1.  ....S J=$P(ORWP(K,0),";",1)
  1.  ....S ORTMP(M)=J_U_$P(ORWP(K,0),";",2)
  1.  E  D GETLST^XPAR(.ORTMP,LVL,"ORQQPX COVER SHEET REMINDERS",TYP,.ORERR)
  1.  S I=0,IDX=$O(RESULT(999999),-1)+1,ADD=(SORT="")
  1.  F  S I=$O(ORTMP(I)) Q:'I  D
  1.  .S (FOUND,J)=0,P2=$P(ORTMP(I),U,2)
  1.  .S FLAG=$E(P2),IEN=$E(P2,2,999)
  1.  .I ADD S DOADD=1
  1.  .E  D
  1.  ..S DOADD=0
  1.  ..F  S J=$O(RESULT(J)) Q:'J  D  Q:FOUND
  1.  ...S P2=$P(RESULT(J),U,2)
  1.  ...S FIEN=$E(P2,2,999)
  1.  ...I FIEN=IEN S FOUND=J,FFLAG=$E(P2)
  1.  ..I FOUND D  I 1
  1.  ...I FLAG="R",FFLAG'="L" K RESULT(FOUND)
  1.  ...I FLAG'=FFLAG,(FLAG_FFLAG)["L" S $E(P2)="L",$P(RESULT(FOUND),U,2)=P2
  1.  ..E  I (FLAG'="R") S DOADD=1
  1.  .I DOADD D
  1.  ..S OUT(IDX)=ORTMP(I)
  1.  ..S $P(OUT(IDX),U)=$P(OUT(IDX),U)_SORT
  1.  ..I SORT="" S OUT(IDX)=$$ADDNAME(OUT(IDX))
  1.  ..S IDX=IDX+1
  1.  M RESULT=OUT
  1.  Q
  1.  ;
  1. ADDREM(RESULT,IDX,IEN) ; Add Reminder to RESULT list
  1.  I $D(RESULT("B",IEN)) Q               ; See if it's in the list
  1.  I '$D(^PXD(811.9,IEN)) Q           ; Check if Exists
  1.  I $P($G(^PXD(811.9,IEN,0)),U,6)'="" Q  ; Check if Active
  1.  ;Check to see if the reminder is assigned to CPRS
  1.  N USAGE
  1.  S USAGE=$P($G(^PXD(811.9,IEN,100)),U,4)
  1.  ;If the Usage is List or Order Check skip it.
  1.  I (USAGE["L")!(USAGE["O") Q
  1.  ;If the Usage is not C or * skip it.
  1.  I USAGE'["C",USAGE'="*" Q
  1.  S RESULT(IDX)=IDX_U_IEN
  1.  S RESULT("B",IEN)=""
  1.  Q
  1.  ;
  1. ADDCAT(RESULT,IDX,IEN) ; Add Category Reminders to ORY list
  1.  N REM,I,IDX2,NREM
  1.  D CATREM^PXRMAPI0(IEN,.REM)
  1.  S I=0
  1.  F  S I=$O(REM(I)) Q:'I  D
  1.  . S IDX2="00000"_I
  1.  . S IDX2=$E(IDX2,$L(IDX2)-5,99)
  1.  . D ADDREM(.RESULT,+(IDX_"."_IDX2),$P(REM(I),U,1))
  1.  Q
  1.  ;
  1. REMLIST(RESULT,PERSON,LOC) ;Returns a list of all cover sheet reminders
  1.  N SRV,I,J,LST,CODE,IDX,IEN,NEWP,USER
  1.  S USER=$S(+$G(PERSON)>0:+$G(PERSON),1:DUZ)
  1.  S SRV=$$GET1^DIQ(200,USER,29,"I")
  1.  D NEWCVOK(.NEWP,USER)
  1.  I 'NEWP D  Q
  1.  . N OLDLIST
  1.  . D GETLST^XPAR(.OLDLIST,"USR.`"_USER_"^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORQQPX SEARCH ITEMS","Q",.ORERR)
  1.  . S I=0
  1.  . F  S I=$O(OLDLIST(I)) Q:'I  D
  1.  .. S IDX=$P(OLDLIST(I),U,1)
  1.  .. F  Q:'$D(RESULT(IDX))  S IDX=IDX+1
  1.  .. S IEN=$P(OLDLIST(I),U,2)
  1.  .. D ADDREM(.RESULT,IDX,IEN)
  1.  . K RESULT("B")
  1.  ;
  1.  D REMACCUM(.LST,"PKG","Q",1000)
  1.  D REMACCUM(.LST,"SYS","Q",2000)
  1.  D REMACCUM(.LST,"DIV","Q",3000)
  1.  I +SRV D REMACCUM(.LST,"SRV.`"_+$G(SRV),"Q",4000)
  1.  I +LOC D REMACCUM(.LST,"LOC.`"_+$G(LOC),"Q",5000)
  1.  D REMACCUM(.LST,"CLASS","Q",6000,"",USER)
  1.  D REMACCUM(.LST,"USR.`"_USER,"Q",7000)
  1.  S I=0
  1.  F  S I=$O(LST(I)) Q:'I  D
  1.  .S IDX=$P(LST(I),U,1)
  1.  .F  Q:'$D(RESULT(IDX))  S IDX=IDX+1
  1.  .S CODE=$E($P(LST(I),U,2),2)
  1.  .S IEN=$E($P(LST(I),U,2),3,999)
  1.  .I CODE="R" D ADDREM(.RESULT,IDX,IEN)
  1.  .I CODE="C" D ADDCAT(.RESULT,IDX,IEN)
  1.  K RESULT("B")
  1.  Q
  1.  ;
  1. LVREMLST(RESULT,LVL,CLASS) ;Returns cover sheet reminders at a specified level
  1.  D REMACCUM(.RESULT,LVL,"Q","",$G(CLASS))
  1.  Q
  1.  ;
  1. GETLVRD(RESULT,LVL,CLASS) ;
  1.  N CAT,CINC,DIEN,IEN,INC,REMLIST,RIEN,REM,TEMP
  1.  D LVREMLST(.REMLIST,LVL,$G(CLASS))
  1.  S INC=0 F  S INC=$O(REMLIST(INC)) Q:INC'>0  D
  1.  . S TEMP=$P($G(REMLIST(INC)),U,2) I TEMP="" Q
  1.  . I $E(TEMP)="R" Q
  1.  . I $E(TEMP,2)="C" D
  1.  .. S CAT=$E(TEMP,3,$L(TEMP))
  1.  .. D CATREM^PXRMAPI0(CAT,.REM)
  1.  .. S CINC=0 F  S CINC=$O(REM(CINC)) Q:CINC'>0  D
  1.  ... S IEN=$G(REM(CINC)) Q:IEN'>0
  1.  ... S DIEN=+$G(^PXD(811.9,IEN,51)) Q:DIEN'>0
  1.  ... S RESULT("REMINDER",DIEN)=""
  1.  . S IEN=$E(TEMP,3,$L(TEMP))
  1.  . S DIEN=+$G(^PXD(811.9,IEN,51)) Q:DIEN'>0
  1.  . S RESULT("REMINDER",DIEN)=""
  1.  Q
  1.  ;
  1. GETDLIST(RESULT,USER,LOC) ;
  1.  ;get coversheet reminders list.
  1.  N IEN,NODE,NUM,REMLIST
  1.  D GETLIST(.REMLIST,USER,$G(LOC))
  1.  S NUM=0 F  S NUM=$O(REMLIST(NUM)) Q:NUM'>0  D
  1.  .S IEN=+$G(REMLIST(NUM)) I IEN'>0 Q
  1.  .I +$G(^PXD(811.9,IEN,51))>0 S RESULT("REMINDER",+$G(^PXD(811.9,IEN,51)))=""
  1.  Q
  1.  ;
  1. GETTDLST(RESULT) ;
  1.  ;get TIU template reminder dialogs list.
  1.  N IEN,NODE,NUM,REMLIST
  1.  S IEN=0 F  S IEN=$O(^TIU(8927,IEN)) Q:IEN'>0  D
  1.  .S NODE=$G(^TIU(8927,IEN,0))
  1.  .I $P(NODE,U,15)>0  S RESULT("TEMPLATE",$P(NODE,U,15))=""
  1.  Q
  1.  ;
  1. GETLIST(RESULT,USER,LOC) ;Returns a list of all cover sheet reminders
  1.  N I
  1.  D REMLIST(.RESULT,USER,$G(LOC))
  1.  S I=0
  1.  F  S I=$O(RESULT(I)) Q:'I  D
  1.  .S RESULT(I)=$P(RESULT(I),U,2)
  1.  Q
  1.  ;
  1. EVALCOVR(RESULT,PT,LOC) ; Evaluate Cover Sheet Reminders
  1.  N ORTMP
  1.  D GETLIST(.ORTMP,$G(LOC))
  1.  D ALIST^ORQQPXRM(.RESULT,PT,.ORTMP)
  1.  Q
  1.  ;