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

ORLP3U2.m

Go to the documentation of this file.
  1. ORLP3U2 ; SLC/PKS - Team List routines. [3/27/00 4:01pm]
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**63**;Dec 17, 1997
  1. ;
  1. Q
  1. ;
  1. DEL ; Called by option: ORLP3M DELETE USER TEAMS.
  1. ; Allows CAC menu deletion of personal Team Lists.
  1. ;
  1. ; Variables used:
  1. ;
  1. ; DIC = Fileman lookup routine.
  1. ; DIK = Fileman deletion routine.
  1. ; ORPTEAM = Personal Team to delete.
  1. ; ORQUIT = Flag for quitting input loop.
  1. ; ORUSER = Temporary user IEN holder.
  1. ; ORHEAD = Flag for user list heading.
  1. ; ORNAME = User name holder.
  1. ; ORNODEL = Flag for no confirmation of deletion.
  1. ;
  1. N ORPQUIT,ORPTEAM,ORQUIT,ORUSER,ORHEAD,ORNAME,ORNODEL
  1. ;
  1. ; Set up loop to control action:
  1. S ORPQUIT=1
  1. F D Q:'ORPQUIT
  1. .K DIC,DIK
  1. .S DIC="^OR(100.21,"
  1. .S DIC(0)="AEQM"
  1. .S DIC("S")="I $P(^OR(100.21,+Y,0),U,2)=""P"""
  1. .S DIC("A")="Select Personal Patient List to delete: "
  1. .W !
  1. .D ^DIC
  1. .K DIC
  1. .I Y<1 S ORPQUIT=0 Q ; Punt if no selection made.
  1. .S ORPTEAM=Y
  1. .;
  1. .; Display any users currently on team:
  1. .S ORHEAD=1 ; Set flag for heading.
  1. .S ORUSER=0
  1. .F S ORUSER=$O(^OR(100.21,+ORPTEAM,1,ORUSER)) Q:+ORUSER=0 D
  1. ..I ORHEAD D ; First time through, print heading.
  1. ...S ORHEAD=0 ; Reset flag.
  1. ...W !!," Users currently on team ",$P(ORPTEAM,U,2),":",! ; Display heading.
  1. ..S ORNAME=$P($G(^VA(200,ORUSER,0)),U) ; Get user's name.
  1. ..W !," ",ORNAME
  1. .I 'ORHEAD W !
  1. .;
  1. .; Get confirmation before deleting the Team List:
  1. .S ORNODEL=0 ; Preset flag.
  1. .S ORQUIT=0
  1. .F Q:ORQUIT=1 D ; Loop to control user entry.
  1. ..S %=1
  1. ..W !,"Are you ready to delete list "_$PIECE(ORPTEAM,U,2)
  1. ..D YN^DICN ; Fileman call for user input.
  1. ..I %=2 S (ORNODEL,ORQUIT)=1 Q ; Set flags if user enters "NO."
  1. ..I %=1 S ORQUIT=1 Q ; "YES" confirmation.
  1. ..W !,"Enter YES to delete the list, NO to quit." ; For inappropriate entries, loop will repeat.
  1. .I ORNODEL=1 Q ; Delete not confirmed.
  1. .W !,"Working..." ; Keep user informed.
  1. .L +^OR(100.21,+ORPTEAM):3 ; Handle file locking.
  1. .S DIK="^OR(100.21,"
  1. .S DA=+ORPTEAM
  1. .D ^DIK ; Delete the Team List.
  1. .K DIC,DIK,DA,Y,%
  1. .L -^OR(100.21,+ORPTEAM) ; Unlock the file.
  1. .W !,"Searching for/removing Consults pointers to deleted team..."
  1. .D CLNLIST^GMRCTU(+ORPTEAM,0) ; Dump team pointers in file 123.5.
  1. .; Leave success message:
  1. .W !,"List deletion completed."
  1. ;
  1. Q
  1. ;
  1. AR ; Called by option: ORLP3U ON/OFF A/L TEAMS.
  1. ; Allows users to add/remove themselves from Autolinked Team Lists.
  1. ; (Thanks to Rebecca Bates, Dayton VAMC, for head start on this.)
  1. ;
  1. ; Variables used:
  1. ;
  1. ; DIR = Fileman user input routine.
  1. ; DIC = Fileman lookup routine.
  1. ; DIE = Fileman edit routine.
  1. ; DIK = Fileman deletion routine.
  1. ; ORTEAM = Holder for team IEN.
  1. ; ORNAME = Holder for team name.
  1. ; ORCNT = Counter variable.
  1. ; ORNONE = Flag; if true there are no current team assignments.
  1. ; ORACT = User input holder.
  1. ; ORRESULT = Result of file locking call.
  1. ;
  1. ; Set up outer control loop for this option's menu function:
  1. N ORACT
  1. S ORACT=0
  1. F Q:ORACT=3 D ; Overall control loop.
  1. .;
  1. .N DIR,DIC,DIE,DIK,ORTEAM,ORNAME,ORNONE,ORRESULT
  1. .W ! ; Leave a blank line on the screen for clarity.
  1. .S ORNONE=1
  1. .I $D(^OR(100.21,"C",DUZ)) S ORNONE=0 D ; Current team assignments display control loop.
  1. ..;
  1. ..; Get list of currently-assigned Teams:
  1. ..S ORTEAM="" ; Initialize.
  1. ..F S ORTEAM=$O(^OR(100.21,"C",DUZ,ORTEAM)) Q:ORTEAM="" D ; Each Team where user is asociated.
  1. ...;
  1. ...; Next two lines of executable code create ^TMP entries as:
  1. ...; ^TMP("ORLPAR",$J,228)="TEAM ABC"
  1. ...; where 228 is a Team List IEN and "TEAM ABC" is a Team name,
  1. ...; and the Team is an autolink type and subscribable (i.e.,
  1. ...; the SUBSCRIBE field has a "Y" entry in it):
  1. ...I $P(^OR(100.21,ORTEAM,0),"^",2)["A",$P($G(^OR(100.21,ORTEAM,0)),"^",6)="Y" S ^TMP("ORLPAR",$J,ORTEAM)=$P(^OR(100.21,ORTEAM,0),"^")
  1. ..;
  1. ..; If still no valid data, reset ORNONE and punt:
  1. ..I '$D(^TMP("ORLPAR",$J)) S ORNONE=1 Q
  1. ..;
  1. ..; Display currently-associated Teams:
  1. ..W !,"You are associated with the following autolinked teams:",!
  1. ..S ORTEAM="" ; Initialize.
  1. ..F S ORTEAM=$O(^TMP("ORLPAR",$J,ORTEAM)) Q:ORTEAM="" D ; Each team name.
  1. ...S ORNAME=^TMP("ORLPAR",$J,ORTEAM) ; Assign name variable.
  1. ...W !," "_ORNAME ; Print to screen.
  1. .;
  1. .; If no current associations, indicate same:
  1. .I ORNONE W !,"You are not currently assigned to any teams."
  1. .W ! ; Whether current assignments or not, leave a blank line for clarity.
  1. .;
  1. .; Set up call to DIR and get user input:
  1. .S DIR("A")="Next action"
  1. .S DIR("B")="Quit"
  1. .S DIR("0")="SET^1:Add;2:Delete;3:Quit"
  1. .S DIR("?")="Enter 1, 2, or 3: "
  1. .I ORNONE D ; Change menu choices if deletions not appropriate.
  1. ..S DIR("0")="S^1:Add;3:Quit"
  1. ..S DIR("?")="Enter either 1 or 3: "
  1. .D ^DIR
  1. .K DIR
  1. .I Y<0!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S ORACT=3 Q ; Quit on errors.
  1. .I (+Y'=1)&(+Y'=2)&(+Y'=3) S ORACT=3 Q ; Quit if no acceptable response.
  1. .S ORACT=+Y ; Assign user's response.
  1. .I ORACT=3 Q ; Quit if user doesn't want any changes.
  1. .;
  1. .; Process deletions:
  1. .I ORACT=2 D ; Deletion control loop.
  1. ..;
  1. ..; Get user input on Team List for removal:
  1. ..S DIC(0)="AEMQZ"
  1. ..S DIC="^OR(100.21,"
  1. ..S DIC("S")="I $D(^TMP(""ORLPAR"",$J,+Y))"
  1. ..S DIC("A")="Autolinked team for removal of yourself as user/provider: "
  1. ..D ^DIC
  1. ..I $D(DTOUT)!$D(DUOUT) Q ; Entry error.
  1. ..I +Y<1 Q ; No selection made or bad selection.
  1. ..S ORTEAM=+Y ; Assign team IEN variable.
  1. ..S ORNAME=Y(0,0) ; Assign team name variable.
  1. ..K DIC
  1. ..;
  1. ..; Remove the user from the list:
  1. ..S ORRESULT=$$ARLOCK
  1. ..I 'ORRESULT Q ; Quit if there's a locking problem.
  1. ..S DA=DUZ
  1. ..S DA(1)=ORTEAM
  1. ..S DIK="^OR(100.21,"_DA(1)_","_1_","
  1. ..D ^DIK
  1. ..K DIK
  1. ..L -^OR(100.21,ORTEAM) ; Clean up file lock.
  1. ..Q
  1. .;
  1. .; Process additions:
  1. .I ORACT=1 D ; Addition control loop.
  1. ..;
  1. ..; Get user input on Team List for addition:
  1. ..S DIC="^OR(100.21,"
  1. ..S DIC(0)="AEMQZ"
  1. ..S DIC("S")="I $P(^OR(100.21,+Y,0),""^"",2)[""A"",$P($G(^OR(100.21,+Y,0)),""^"",6)=""Y"",'$D(^TMP(""ORLPAR"",$J,+Y))"
  1. ..S DIC("A")="Autolinked team for addition of yourself as user/provider: "
  1. ..D ^DIC
  1. ..K DIC
  1. ..I $D(DTOUT)!$D(DUOUT) Q ; Entry error.
  1. ..I Y<1 Q ; No selection made or bad selection.
  1. ..S ORTEAM=+Y ; Assign Team IEN variable.
  1. ..;
  1. ..; Add user to selected Team List:
  1. ..S ORRESULT=$$ARLOCK
  1. ..I 'ORRESULT Q ; Quit if there's a locking problem.
  1. ..K Y,X
  1. ..S DIC("P")=$P(^DD(100.21,2,0),"^",2)
  1. ..S DIC(0)="LM"
  1. ..S DA=DUZ
  1. ..S DA(1)=ORTEAM
  1. ..S DLAYGO=100.212
  1. ..S X=$P($G(^VA(200,DUZ,0)),"^",1)
  1. ..S DIC="^OR(100.21,"_DA(1)_",1,"
  1. ..D ^DIC
  1. ..K DIC,DLAYGO
  1. ..L -^OR(100.21,ORTEAM) ; Clean up file lock.
  1. ..Q
  1. .;
  1. .K ^TMP("ORLPAR",$J) ; Cleanup each time through.
  1. ;
  1. K ^TMP("ORLPAR",$J) ; Cleanup at end to be sure.
  1. K DIRUT,DTOUT,DUOUT ; Cleanup error variables.
  1. Q
  1. ;
  1. ARLOCK(ORTEST) ; Handle locking of select Team List before editing.
  1. ;
  1. ; Variable used:
  1. ;
  1. ; ORTEST = Result of locking call.
  1. ;
  1. L +^OR(100.21,ORTEAM):5
  1. S ORTEST=$TEST
  1. I 'ORTEST W !,"Another user is editing this team.",!
  1. Q ORTEST
  1. ;