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

ORLP3U1.m

Go to the documentation of this file. 
  1. ORLP3U1 ; SLC/CLA - Utilities which support OE/RR 3 Team/Patient Lists ; [1/3/01 1:38pm]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,63,98**;Dec 17, 1997
  1.  ;
  1.  ; SLC/PKS: Changes made - 8/99.
  1.  ;
  1.  Q
  1.  ;
  1. WINACT(ORWARD) ; returns "1" if ward (^DIC(42,) is inactive
  1.  N D0
  1.  Q:'$L($G(ORWARD)) 0
  1.  S D0=ORWARD
  1.  D WIN^DGPMDDCF
  1.  Q X
  1.  ;
  1. USRTMS ; display a user's teams
  1.  ; Modified by PKS.
  1.  N ORUSR,ORUSRN,ORY,ORI,ORCNT,ORTM,ORTMN,ORTYPE
  1.  S ORI="",ORCNT=0
  1.  W ! K DIC S DIC="^VA(200,",DIC(0)="AEQN",DIC("B")=DUZ
  1.  S DIC("A")="Find teams linked to user: "
  1.  D ^DIC Q:Y<1  S ORUSR=+Y,ORUSRN=$P(Y,U,2) K DIC,Y,DUOUT,DTOUT
  1.  ; Call to TEAMPR changed to TEAMPR2 by PKS/slc - 8/1999:
  1.  D TEAMPR2^ORQPTQ1(.ORY,ORUSR)
  1.  D OUTTMS
  1.  Q
  1.  ;
  1. DUZTMS ; display current user's teams
  1.  ; Modified by PKS.
  1.  N ORUSRN,ORY,ORI,ORCNT,ORTM,ORTMN,ORTYPE
  1.  S ORI="",ORCNT=0
  1.  ; Call to TEAMPR changed to TEAMPR2 by PKS:
  1.  D TEAMPR2^ORQPTQ1(.ORY,DUZ)
  1.  S ORUSRN=$P(^VA(200,DUZ,0),U)
  1.  D OUTTMS
  1.  Q
  1.  ;
  1. USRTMPTS ; display patients linked to a user via teams
  1.  ; Modified by PKS.
  1.  ;
  1.  ; Notes:  The TPROVPT^ORQPTQ1 call in USRTMPTS and DUZTMPTS tags
  1.  ;         writes ^TMP("ORLPUPT",$J).  Returning, code in OUTPTS4
  1.  ;         here writes a new global, ^XUTL("OR",$J,"ORLP") including
  1.  ;         a "B" index.  Modifications by PKS in 8/1999 left this 
  1.  ;         functionality unchanged for backwards compatibility.  But 
  1.  ;         a new "C" index was written to sort for new functionality
  1.  ;         and a new global, ^XUTL("OR",$J,"ORLPTL"), is written in
  1.  ;         order for new output functionality for the display of 
  1.  ;         patients sorted alphabetically by teams.
  1.  ;
  1.  ;         The length of the displayed Team Name is set by the 
  1.  ;         variable ORTMNLEN.
  1.  ;
  1.  N ORUSR,ORUSRN,ORI,ORCNT,ORBCNT,ORCCNT,ORPT,ORPTN,ORTMN,ORTMNSTR,ORDATA,ORTMNLEN
  1.  S ORTMN="",ORCNT=0,ORBCNT=0,ORCCNT=0,ORTMNLEN=10
  1.  W ! K DIC S DIC="^VA(200,",DIC(0)="AEQN",DIC("B")=DUZ
  1.  S DIC("A")="Find patients linked via teams to user: "
  1.  D ^DIC Q:Y<1  S ORUSR=+Y,ORUSRN=$P(Y,U,2) K DIC,Y,DUOUT,DTOUT
  1.  K ^TMP("ORLPUPT",$J)
  1.  D TPROVPT^ORQPTQ1(ORUSR)
  1.  D OUTPTS
  1.  Q
  1.  ;
  1. DUZTMPTS ; display patients linked to current user via teams
  1.  ; Modified by PKS.
  1.  ;
  1.  N ORUSR,ORUSRN,ORI,ORCNT,ORBCNT,ORCCNT,ORPT,ORPTN,ORTMN,ORTMNSTR,ORDATA,ORTMNLEN
  1.  S ORTMN="",ORCNT=0,ORBCNT=0,ORCCNT=0,ORTMNLEN=10
  1.  S ORUSRN=$P(^VA(200,DUZ,0),U)
  1.  K ^TMP("ORLPUPT",$J)
  1.  D TPROVPT^ORQPTQ1(DUZ)
  1.  D OUTPTS
  1.  Q
  1.  ;
  1. OUTTMS ; Output teams.
  1.  ; Code moved and modified by PKS.
  1.  ;
  1.  K ^XUTL("OR",$J) ; Just in case.
  1.  ;
  1.  F  S ORI=$O(ORY(ORI)) Q:ORI=""  D
  1.  .; Next line changed by PKS:
  1.  .S ORTM=$P(ORY(ORI),U),ORTMN=$P(ORY(ORI),U,2),ORTYPE=$P(ORY(ORI),U,3)
  1.  .S ORTM=$S($L(ORTM):ORTM,1:1)
  1.  .; Next 2 lines new or modified by PKS:
  1.  .D TYPESTR ; Assign descriptive type string.
  1.  .S ^XUTL("OR",$J,"ORLP",ORTM,0)=ORTMN_U_ORTYPE,ORCNT=ORCNT+1
  1.  .S ^XUTL("OR",$J,"ORLP","B",ORTMN,ORTM)=""
  1.  S ^XUTL("OR",$J,"ORLP",0)=U_U_ORCNT
  1.  ;
  1.  N COL,HDR,PIE,ROOT
  1.  ; Next line modified by PKS:
  1.  S ROOT="^XUTL(""OR"",$J,""ORLP"",",PIE="1^2",COL=2
  1.  S HDR=ORUSRN_" is on the following teams:"
  1.  D EN^ORULG(ROOT,PIE,HDR,COL)
  1.  K ^XUTL("OR",$J)
  1.  Q
  1.  ;
  1. OUTPTS ; Output patients alphabetically by teams.
  1.  ; Code moved and modified by PKS.
  1.  ;
  1.  K ^XUTL("OR",$J)                               ; Just in case.
  1.  ;
  1.  ; Order through for each team:
  1.  F  S ORTMN=$O(^TMP("ORLPUPT",$J,"B",ORTMN)) Q:ORTMN=""  D
  1.  .S ORTMNSTR=ORTMN ; Check name string (here), length (next line).
  1.  .I $L(ORTMN)>ORTMNLEN SET ORTMNSTR=$E(ORTMN,1,ORTMNLEN)_".."
  1.  .S ORTMNSTR="("_ORTMNSTR_")"                   ; Add parenthesis.
  1.  .;
  1.  .; Order through again for each patient:
  1.  .S ORI=""
  1.  .F  S ORI=$O(^TMP("ORLPUPT",$J,"B",ORTMN,ORI)) Q:ORI=""  D
  1.  ..S ORCNT=ORCNT+1                              ; Top-level counter.
  1.  ..S ORBCNT=ORBCNT+1                            ; This node's counter.
  1.  ..S ORPT=$P(ORI,U,2)                           ; DFN
  1.  ..S ORPT=$S($L(ORPT):ORPT,1:1)                 ; A default of 1.
  1.  ..S ORPTN=$P(ORI,U)                            ; Patient name.
  1.  ..S ^XUTL("OR",$J,"ORLP",ORPT,0)=ORPTN         ; Write to ^XUTL.
  1.  ..S ^XUTL("OR",$J,"ORLP","B",ORPTN,ORPT)=""    ; "B" index of ^XUTL.
  1.  ..;
  1.  ..; Write new "C" index of ^XUTL:
  1.  ..S ^XUTL("OR",$J,"ORLP","C",ORTMN_U_ORPTN_U_ORPT)=ORPTN_U_ORTMNSTR
  1.  ..;
  1.  ; Write new ^XUTL file entries:
  1.  S ORDATA=""
  1.  F  S ORDATA=$O(^XUTL("OR",$J,"ORLP","C",ORDATA)) Q:ORDATA=""  D
  1.  .S ORCNT=ORCNT+1                              ; Top-level counter.
  1.  .S ORCCNT=ORCCNT+1                            ; This node's counter.
  1.  .S ^XUTL("OR",$J,"ORLPTL",ORCCNT,0)=$G(^XUTL("OR",$J,"ORLP","C",ORDATA))
  1.  K ^TMP("ORLPUPT",$J)                           ; Finished with ^TMP.
  1.  ;
  1.  ; Make required FM entries before proceeding:
  1.  S ^XUTL("OR",$J,0)=U_U_ORCNT                   ; Top-level 0-node.
  1.  S ^XUTL("OR",$J,"ORLP",0)=U_U_ORBCNT           ; Next level 0-node.
  1.  S ^XUTL("OR",$J,"ORLPTL",0)=U_U_ORCCNT         ; Other level, same.
  1.  ;
  1.  ; Check for no entries (in ^XUTL):
  1.  I ORCNT=0,ORBCNT=0,ORCCNT=0  D
  1.  .K ^XUTL("OR",$J)                              ; Clean house now.
  1.  .S ^XUTL("OR",$J,"ORLPTL",0)=U_U_1             ; Set 0-node.
  1.  .;
  1.  .; Prepare user message:
  1.  .S ^XUTL("OR",$J,"ORLPTL",1,0)="No linked patients found."_U
  1.  .; Assign corresponding "B" x-ref:
  1.  .S ^XUTL("OR",$J,"ORLPTL","B","No linke patients found.",1)=""
  1.  .Q
  1.  ;
  1.  ; Call routine for output:
  1.  N COL,HDR,PIE,ROOT
  1.  S ROOT="^XUTL(""OR"",$J,""ORLPTL"",",PIE="1^2",COL=2
  1.  S HDR=ORUSRN_" is linked to the following patients via teams:"
  1.  D EN^ORULG(ROOT,PIE,HDR,COL)
  1.  K ^XUTL("OR",$J)
  1.  Q
  1.  ;
  1. TYPESTR ; Assign description strings to ORTYPE (Team List type) variables.
  1.  ; New tag by PKS.
  1.  ;
  1.  I ORTYPE="P" S ORTYPE="(PERSONAL)"
  1.  I ORTYPE="TA" S ORTYPE="(AUTOLINK)"
  1.  I ORTYPE="TM" S ORTYPE="(MANUAL)"
  1.  I ORTYPE="MRAL" S ORTYPE="(MRAL)"
  1.  Q
  1.  ;