ORLP3U2 ; SLC/PKS - Team List routines. [3/27/00 4:01pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**63**;Dec 17, 1997
;
Q
;
DEL ; Called by option: ORLP3M DELETE USER TEAMS.
; Allows CAC menu deletion of personal Team Lists.
;
; Variables used:
;
; DIC = Fileman lookup routine.
; DIK = Fileman deletion routine.
; ORPTEAM = Personal Team to delete.
; ORQUIT = Flag for quitting input loop.
; ORUSER = Temporary user IEN holder.
; ORHEAD = Flag for user list heading.
; ORNAME = User name holder.
; ORNODEL = Flag for no confirmation of deletion.
;
N ORPQUIT,ORPTEAM,ORQUIT,ORUSER,ORHEAD,ORNAME,ORNODEL
;
; Set up loop to control action:
S ORPQUIT=1
F D Q:'ORPQUIT
.K DIC,DIK
.S DIC="^OR(100.21,"
.S DIC(0)="AEQM"
.S DIC("S")="I $P(^OR(100.21,+Y,0),U,2)=""P"""
.S DIC("A")="Select Personal Patient List to delete: "
.W !
.D ^DIC
.K DIC
.I Y<1 S ORPQUIT=0 Q ; Punt if no selection made.
.S ORPTEAM=Y
.;
.; Display any users currently on team:
.S ORHEAD=1 ; Set flag for heading.
.S ORUSER=0
.F S ORUSER=$O(^OR(100.21,+ORPTEAM,1,ORUSER)) Q:+ORUSER=0 D
..I ORHEAD D ; First time through, print heading.
...S ORHEAD=0 ; Reset flag.
...W !!," Users currently on team ",$P(ORPTEAM,U,2),":",! ; Display heading.
..S ORNAME=$P($G(^VA(200,ORUSER,0)),U) ; Get user's name.
..W !," ",ORNAME
.I 'ORHEAD W !
.;
.; Get confirmation before deleting the Team List:
.S ORNODEL=0 ; Preset flag.
.S ORQUIT=0
.F Q:ORQUIT=1 D ; Loop to control user entry.
..S %=1
..W !,"Are you ready to delete list "_$PIECE(ORPTEAM,U,2)
..D YN^DICN ; Fileman call for user input.
..I %=2 S (ORNODEL,ORQUIT)=1 Q ; Set flags if user enters "NO."
..I %=1 S ORQUIT=1 Q ; "YES" confirmation.
..W !,"Enter YES to delete the list, NO to quit." ; For inappropriate entries, loop will repeat.
.I ORNODEL=1 Q ; Delete not confirmed.
.W !,"Working..." ; Keep user informed.
.L +^OR(100.21,+ORPTEAM):3 ; Handle file locking.
.S DIK="^OR(100.21,"
.S DA=+ORPTEAM
.D ^DIK ; Delete the Team List.
.K DIC,DIK,DA,Y,%
.L -^OR(100.21,+ORPTEAM) ; Unlock the file.
.W !,"Searching for/removing Consults pointers to deleted team..."
.D CLNLIST^GMRCTU(+ORPTEAM,0) ; Dump team pointers in file 123.5.
.; Leave success message:
.W !,"List deletion completed."
;
Q
;
AR ; Called by option: ORLP3U ON/OFF A/L TEAMS.
; Allows users to add/remove themselves from Autolinked Team Lists.
; (Thanks to Rebecca Bates, Dayton VAMC, for head start on this.)
;
; Variables used:
;
; DIR = Fileman user input routine.
; DIC = Fileman lookup routine.
; DIE = Fileman edit routine.
; DIK = Fileman deletion routine.
; ORTEAM = Holder for team IEN.
; ORNAME = Holder for team name.
; ORCNT = Counter variable.
; ORNONE = Flag; if true there are no current team assignments.
; ORACT = User input holder.
; ORRESULT = Result of file locking call.
;
; Set up outer control loop for this option's menu function:
N ORACT
S ORACT=0
F Q:ORACT=3 D ; Overall control loop.
.;
.N DIR,DIC,DIE,DIK,ORTEAM,ORNAME,ORNONE,ORRESULT
.W ! ; Leave a blank line on the screen for clarity.
.S ORNONE=1
.I $D(^OR(100.21,"C",DUZ)) S ORNONE=0 D ; Current team assignments display control loop.
..;
..; Get list of currently-assigned Teams:
..S ORTEAM="" ; Initialize.
..F S ORTEAM=$O(^OR(100.21,"C",DUZ,ORTEAM)) Q:ORTEAM="" D ; Each Team where user is asociated.
...;
...; Next two lines of executable code create ^TMP entries as:
...; ^TMP("ORLPAR",$J,228)="TEAM ABC"
...; where 228 is a Team List IEN and "TEAM ABC" is a Team name,
...; and the Team is an autolink type and subscribable (i.e.,
...; the SUBSCRIBE field has a "Y" entry in it):
...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),"^")
..;
..; If still no valid data, reset ORNONE and punt:
..I '$D(^TMP("ORLPAR",$J)) S ORNONE=1 Q
..;
..; Display currently-associated Teams:
..W !,"You are associated with the following autolinked teams:",!
..S ORTEAM="" ; Initialize.
..F S ORTEAM=$O(^TMP("ORLPAR",$J,ORTEAM)) Q:ORTEAM="" D ; Each team name.
...S ORNAME=^TMP("ORLPAR",$J,ORTEAM) ; Assign name variable.
...W !," "_ORNAME ; Print to screen.
.;
.; If no current associations, indicate same:
.I ORNONE W !,"You are not currently assigned to any teams."
.W ! ; Whether current assignments or not, leave a blank line for clarity.
.;
.; Set up call to DIR and get user input:
.S DIR("A")="Next action"
.S DIR("B")="Quit"
.S DIR("0")="SET^1:Add;2:Delete;3:Quit"
.S DIR("?")="Enter 1, 2, or 3: "
.I ORNONE D ; Change menu choices if deletions not appropriate.
..S DIR("0")="S^1:Add;3:Quit"
..S DIR("?")="Enter either 1 or 3: "
.D ^DIR
.K DIR
.I Y<0!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S ORACT=3 Q ; Quit on errors.
.I (+Y'=1)&(+Y'=2)&(+Y'=3) S ORACT=3 Q ; Quit if no acceptable response.
.S ORACT=+Y ; Assign user's response.
.I ORACT=3 Q ; Quit if user doesn't want any changes.
.;
.; Process deletions:
.I ORACT=2 D ; Deletion control loop.
..;
..; Get user input on Team List for removal:
..S DIC(0)="AEMQZ"
..S DIC="^OR(100.21,"
..S DIC("S")="I $D(^TMP(""ORLPAR"",$J,+Y))"
..S DIC("A")="Autolinked team for removal of yourself as user/provider: "
..D ^DIC
..I $D(DTOUT)!$D(DUOUT) Q ; Entry error.
..I +Y<1 Q ; No selection made or bad selection.
..S ORTEAM=+Y ; Assign team IEN variable.
..S ORNAME=Y(0,0) ; Assign team name variable.
..K DIC
..;
..; Remove the user from the list:
..S ORRESULT=$$ARLOCK
..I 'ORRESULT Q ; Quit if there's a locking problem.
..S DA=DUZ
..S DA(1)=ORTEAM
..S DIK="^OR(100.21,"_DA(1)_","_1_","
..D ^DIK
..K DIK
..L -^OR(100.21,ORTEAM) ; Clean up file lock.
..Q
.;
.; Process additions:
.I ORACT=1 D ; Addition control loop.
..;
..; Get user input on Team List for addition:
..S DIC="^OR(100.21,"
..S DIC(0)="AEMQZ"
..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))"
..S DIC("A")="Autolinked team for addition of yourself as user/provider: "
..D ^DIC
..K DIC
..I $D(DTOUT)!$D(DUOUT) Q ; Entry error.
..I Y<1 Q ; No selection made or bad selection.
..S ORTEAM=+Y ; Assign Team IEN variable.
..;
..; Add user to selected Team List:
..S ORRESULT=$$ARLOCK
..I 'ORRESULT Q ; Quit if there's a locking problem.
..K Y,X
..S DIC("P")=$P(^DD(100.21,2,0),"^",2)
..S DIC(0)="LM"
..S DA=DUZ
..S DA(1)=ORTEAM
..S DLAYGO=100.212
..S X=$P($G(^VA(200,DUZ,0)),"^",1)
..S DIC="^OR(100.21,"_DA(1)_",1,"
..D ^DIC
..K DIC,DLAYGO
..L -^OR(100.21,ORTEAM) ; Clean up file lock.
..Q
.;
.K ^TMP("ORLPAR",$J) ; Cleanup each time through.
;
K ^TMP("ORLPAR",$J) ; Cleanup at end to be sure.
K DIRUT,DTOUT,DUOUT ; Cleanup error variables.
Q
;
ARLOCK(ORTEST) ; Handle locking of select Team List before editing.
;
; Variable used:
;
; ORTEST = Result of locking call.
;
L +^OR(100.21,ORTEAM):5
S ORTEST=$TEST
I 'ORTEST W !,"Another user is editing this team.",!
Q ORTEST
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLP3U2 7668 printed Oct 16, 2024@18:32:03 Page 2
ORLP3U2 ; SLC/PKS - Team List routines. [3/27/00 4:01pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**63**;Dec 17, 1997
+2 ;
+3 QUIT
+4 ;
DEL ; Called by option: ORLP3M DELETE USER TEAMS.
+1 ; Allows CAC menu deletion of personal Team Lists.
+2 ;
+3 ; Variables used:
+4 ;
+5 ; DIC = Fileman lookup routine.
+6 ; DIK = Fileman deletion routine.
+7 ; ORPTEAM = Personal Team to delete.
+8 ; ORQUIT = Flag for quitting input loop.
+9 ; ORUSER = Temporary user IEN holder.
+10 ; ORHEAD = Flag for user list heading.
+11 ; ORNAME = User name holder.
+12 ; ORNODEL = Flag for no confirmation of deletion.
+13 ;
+14 NEW ORPQUIT,ORPTEAM,ORQUIT,ORUSER,ORHEAD,ORNAME,ORNODEL
+15 ;
+16 ; Set up loop to control action:
+17 SET ORPQUIT=1
+18 FOR
Begin DoDot:1
+19 KILL DIC,DIK
+20 SET DIC="^OR(100.21,"
+21 SET DIC(0)="AEQM"
+22 SET DIC("S")="I $P(^OR(100.21,+Y,0),U,2)=""P"""
+23 SET DIC("A")="Select Personal Patient List to delete: "
+24 WRITE !
+25 DO ^DIC
+26 KILL DIC
+27 ; Punt if no selection made.
IF Y<1
SET ORPQUIT=0
QUIT
+28 SET ORPTEAM=Y
+29 ;
+30 ; Display any users currently on team:
+31 ; Set flag for heading.
SET ORHEAD=1
+32 SET ORUSER=0
+33 FOR
SET ORUSER=$ORDER(^OR(100.21,+ORPTEAM,1,ORUSER))
if +ORUSER=0
QUIT
Begin DoDot:2
+34 ; First time through, print heading.
IF ORHEAD
Begin DoDot:3
+35 ; Reset flag.
SET ORHEAD=0
+36 ; Display heading.
WRITE !!," Users currently on team ",$PIECE(ORPTEAM,U,2),":",!
End DoDot:3
+37 ; Get user's name.
SET ORNAME=$PIECE($GET(^VA(200,ORUSER,0)),U)
+38 WRITE !," ",ORNAME
End DoDot:2
+39 IF 'ORHEAD
WRITE !
+40 ;
+41 ; Get confirmation before deleting the Team List:
+42 ; Preset flag.
SET ORNODEL=0
+43 SET ORQUIT=0
+44 ; Loop to control user entry.
FOR
if ORQUIT=1
QUIT
Begin DoDot:2
+45 SET %=1
+46 WRITE !,"Are you ready to delete list "_$PIECE(ORPTEAM,U,2)
+47 ; Fileman call for user input.
DO YN^DICN
+48 ; Set flags if user enters "NO."
IF %=2
SET (ORNODEL,ORQUIT)=1
QUIT
+49 ; "YES" confirmation.
IF %=1
SET ORQUIT=1
QUIT
+50 ; For inappropriate entries, loop will repeat.
WRITE !,"Enter YES to delete the list, NO to quit."
End DoDot:2
+51 ; Delete not confirmed.
IF ORNODEL=1
QUIT
+52 ; Keep user informed.
WRITE !,"Working..."
+53 ; Handle file locking.
LOCK +^OR(100.21,+ORPTEAM):3
+54 SET DIK="^OR(100.21,"
+55 SET DA=+ORPTEAM
+56 ; Delete the Team List.
DO ^DIK
+57 KILL DIC,DIK,DA,Y,%
+58 ; Unlock the file.
LOCK -^OR(100.21,+ORPTEAM)
+59 WRITE !,"Searching for/removing Consults pointers to deleted team..."
+60 ; Dump team pointers in file 123.5.
DO CLNLIST^GMRCTU(+ORPTEAM,0)
+61 ; Leave success message:
+62 WRITE !,"List deletion completed."
End DoDot:1
if 'ORPQUIT
QUIT
+63 ;
+64 QUIT
+65 ;
AR ; Called by option: ORLP3U ON/OFF A/L TEAMS.
+1 ; Allows users to add/remove themselves from Autolinked Team Lists.
+2 ; (Thanks to Rebecca Bates, Dayton VAMC, for head start on this.)
+3 ;
+4 ; Variables used:
+5 ;
+6 ; DIR = Fileman user input routine.
+7 ; DIC = Fileman lookup routine.
+8 ; DIE = Fileman edit routine.
+9 ; DIK = Fileman deletion routine.
+10 ; ORTEAM = Holder for team IEN.
+11 ; ORNAME = Holder for team name.
+12 ; ORCNT = Counter variable.
+13 ; ORNONE = Flag; if true there are no current team assignments.
+14 ; ORACT = User input holder.
+15 ; ORRESULT = Result of file locking call.
+16 ;
+17 ; Set up outer control loop for this option's menu function:
+18 NEW ORACT
+19 SET ORACT=0
+20 ; Overall control loop.
FOR
if ORACT=3
QUIT
Begin DoDot:1
+21 ;
+22 NEW DIR,DIC,DIE,DIK,ORTEAM,ORNAME,ORNONE,ORRESULT
+23 ; Leave a blank line on the screen for clarity.
WRITE !
+24 SET ORNONE=1
+25 ; Current team assignments display control loop.
IF $DATA(^OR(100.21,"C",DUZ))
SET ORNONE=0
Begin DoDot:2
+26 ;
+27 ; Get list of currently-assigned Teams:
+28 ; Initialize.
SET ORTEAM=""
+29 ; Each Team where user is asociated.
FOR
SET ORTEAM=$ORDER(^OR(100.21,"C",DUZ,ORTEAM))
if ORTEAM=""
QUIT
Begin DoDot:3
+30 ;
+31 ; Next two lines of executable code create ^TMP entries as:
+32 ; ^TMP("ORLPAR",$J,228)="TEAM ABC"
+33 ; where 228 is a Team List IEN and "TEAM ABC" is a Team name,
+34 ; and the Team is an autolink type and subscribable (i.e.,
+35 ; the SUBSCRIBE field has a "Y" entry in it):
+36 IF $PIECE(^OR(100.21,ORTEAM,0),"^",2)["A"
IF $PIECE($GET(^OR(100.21,ORTEAM,0)),"^",6)="Y"
SET ^TMP("ORLPAR",$JOB,ORTEAM)=$PIECE(^OR(100.21,ORTEAM,0),"^")
End DoDot:3
+37 ;
+38 ; If still no valid data, reset ORNONE and punt:
+39 IF '$DATA(^TMP("ORLPAR",$JOB))
SET ORNONE=1
QUIT
+40 ;
+41 ; Display currently-associated Teams:
+42 WRITE !,"You are associated with the following autolinked teams:",!
+43 ; Initialize.
SET ORTEAM=""
+44 ; Each team name.
FOR
SET ORTEAM=$ORDER(^TMP("ORLPAR",$JOB,ORTEAM))
if ORTEAM=""
QUIT
Begin DoDot:3
+45 ; Assign name variable.
SET ORNAME=^TMP("ORLPAR",$JOB,ORTEAM)
+46 ; Print to screen.
WRITE !," "_ORNAME
End DoDot:3
End DoDot:2
+47 ;
+48 ; If no current associations, indicate same:
+49 IF ORNONE
WRITE !,"You are not currently assigned to any teams."
+50 ; Whether current assignments or not, leave a blank line for clarity.
WRITE !
+51 ;
+52 ; Set up call to DIR and get user input:
+53 SET DIR("A")="Next action"
+54 SET DIR("B")="Quit"
+55 SET DIR("0")="SET^1:Add;2:Delete;3:Quit"
+56 SET DIR("?")="Enter 1, 2, or 3: "
+57 ; Change menu choices if deletions not appropriate.
IF ORNONE
Begin DoDot:2
+58 SET DIR("0")="S^1:Add;3:Quit"
+59 SET DIR("?")="Enter either 1 or 3: "
End DoDot:2
+60 DO ^DIR
+61 KILL DIR
+62 ; Quit on errors.
IF Y<0!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET ORACT=3
QUIT
+63 ; Quit if no acceptable response.
IF (+Y'=1)&(+Y'=2)&(+Y'=3)
SET ORACT=3
QUIT
+64 ; Assign user's response.
SET ORACT=+Y
+65 ; Quit if user doesn't want any changes.
IF ORACT=3
QUIT
+66 ;
+67 ; Process deletions:
+68 ; Deletion control loop.
IF ORACT=2
Begin DoDot:2
+69 ;
+70 ; Get user input on Team List for removal:
+71 SET DIC(0)="AEMQZ"
+72 SET DIC="^OR(100.21,"
+73 SET DIC("S")="I $D(^TMP(""ORLPAR"",$J,+Y))"
+74 SET DIC("A")="Autolinked team for removal of yourself as user/provider: "
+75 DO ^DIC
+76 ; Entry error.
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+77 ; No selection made or bad selection.
IF +Y<1
QUIT
+78 ; Assign team IEN variable.
SET ORTEAM=+Y
+79 ; Assign team name variable.
SET ORNAME=Y(0,0)
+80 KILL DIC
+81 ;
+82 ; Remove the user from the list:
+83 SET ORRESULT=$$ARLOCK
+84 ; Quit if there's a locking problem.
IF 'ORRESULT
QUIT
+85 SET DA=DUZ
+86 SET DA(1)=ORTEAM
+87 SET DIK="^OR(100.21,"_DA(1)_","_1_","
+88 DO ^DIK
+89 KILL DIK
+90 ; Clean up file lock.
LOCK -^OR(100.21,ORTEAM)
+91 QUIT
End DoDot:2
+92 ;
+93 ; Process additions:
+94 ; Addition control loop.
IF ORACT=1
Begin DoDot:2
+95 ;
+96 ; Get user input on Team List for addition:
+97 SET DIC="^OR(100.21,"
+98 SET DIC(0)="AEMQZ"
+99 SET 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))"
+100 SET DIC("A")="Autolinked team for addition of yourself as user/provider: "
+101 DO ^DIC
+102 KILL DIC
+103 ; Entry error.
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+104 ; No selection made or bad selection.
IF Y<1
QUIT
+105 ; Assign Team IEN variable.
SET ORTEAM=+Y
+106 ;
+107 ; Add user to selected Team List:
+108 SET ORRESULT=$$ARLOCK
+109 ; Quit if there's a locking problem.
IF 'ORRESULT
QUIT
+110 KILL Y,X
+111 SET DIC("P")=$PIECE(^DD(100.21,2,0),"^",2)
+112 SET DIC(0)="LM"
+113 SET DA=DUZ
+114 SET DA(1)=ORTEAM
+115 SET DLAYGO=100.212
+116 SET X=$PIECE($GET(^VA(200,DUZ,0)),"^",1)
+117 SET DIC="^OR(100.21,"_DA(1)_",1,"
+118 DO ^DIC
+119 KILL DIC,DLAYGO
+120 ; Clean up file lock.
LOCK -^OR(100.21,ORTEAM)
+121 QUIT
End DoDot:2
+122 ;
+123 ; Cleanup each time through.
KILL ^TMP("ORLPAR",$JOB)
End DoDot:1
+124 ;
+125 ; Cleanup at end to be sure.
KILL ^TMP("ORLPAR",$JOB)
+126 ; Cleanup error variables.
KILL DIRUT,DTOUT,DUOUT
+127 QUIT
+128 ;
ARLOCK(ORTEST) ; Handle locking of select Team List before editing.
+1 ;
+2 ; Variable used:
+3 ;
+4 ; ORTEST = Result of locking call.
+5 ;
+6 LOCK +^OR(100.21,ORTEAM):5
+7 SET ORTEST=$TEST
+8 IF 'ORTEST
WRITE !,"Another user is editing this team.",!
+9 QUIT ORTEST
+10 ;
