- 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 Jan 18, 2025@03:32:38 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 ;