ORY44C.m

ORY44C ; SLC/PKS  OE/RR - Delete Personal lists for terminated users. ; [2/21/00 1:02pm]

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**44**;Dec 17, 1997

 ;

 Q

 ;

EN ; Clean out Team Lists of type "Personal" with only one user when

 ;    user has been terminated.

 ;

 N DIK,DA,Y,ORLPTYPE,ORLPTEAM,ORLPCNT,ORLPFRST,ORLPUSER,ORLPTNM

 ;

 ; Order through each team in the file:

 S ORLPTEAM=0

 F  S ORLPTEAM=$O(^OR(100.21,ORLPTEAM)) Q:+ORLPTEAM=0  D

 .;

 .; Find out if team is "Personal" type:

 .I $P(^OR(100.21,ORLPTEAM,0),U,2)="P" D

 ..;

 ..; Check users currently on team:

 ..S ORLPFRST=""

 ..S ORLPCNT=0

 ..S ORLPUSER=0

 ..F  S ORLPUSER=$O(^OR(100.21,+ORLPTEAM,1,ORLPUSER)) Q:+ORLPUSER=0  D

 ...S ORLPCNT=ORLPCNT+1 ; Increment counter.

 ...I ORLPCNT=1 S ORLPFRST=ORLPUSER ; Get first user.

 ...I ORLPCNT>1 Q                   ; If more than one user, punt.

 ..;

 ..; Check for none or only one user:

 ..I ORLPCNT=0!'(ORLPFRST="") D

 ...;

 ...; Find out if user is terminated:

 ...I ORLPCNT=0!'($$ACTIVE^XUSER(+ORLPFRST)) D

 ....S ORLPTNM=$P(^OR(100.21,ORLPTEAM,0),U,1) ; Get name of Team List.

 ....;

 ....; Dump team if of type "Personal" (and only user is terminated):

 ....L +^OR(100.21,+ORLPTEAM):3     ; Handle file locking.

 ....S DIK="^OR(100.21,"

 ....S DA=+ORLPTEAM

 ....D ^DIK                         ; Delete the Team List.

 ....K DIK,DA,Y,%                   ; Clean up after call to DIK.

 ....L -^OR(100.21,+ORLPTEAM)       ; Unlock the file.

 ....D MES^XPDUTL("Personal Team "_ORLPTNM_" / IEN "_+ORLPTEAM_" deleted.") ; Installation message to run under Taskman.

 ....;

 ....; Call Consults package code to delete pointers there:

 ....D CLNLIST^GMRCTU(+ORLPTEAM,1)

 ;

 Q

 ;

ORY44C    ; SLC/PKS  OE/RR - Delete Personal lists for terminated users. ; [2/21/00 1:02pm]

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**44**;Dec 17, 1997

 +2       ;

 +3        QUIT 

 +4       ;

EN        ; Clean out Team Lists of type "Personal" with only one user when

 +1       ;    user has been terminated.

 +2       ;

 +3        NEW DIK,DA,Y,ORLPTYPE,ORLPTEAM,ORLPCNT,ORLPFRST,ORLPUSER,ORLPTNM

 +4       ;

 +5       ; Order through each team in the file:

 +6        SET ORLPTEAM=0

 +7        FOR 

               SET ORLPTEAM=$ORDER(^OR(100.21,ORLPTEAM))

               IF +ORLPTEAM=0

                   QUIT 

               Begin DoDot:1

 +8       ;

 +9       ; Find out if team is "Personal" type:

 +10               IF $PIECE(^OR(100.21,ORLPTEAM,0),U,2)="P"

                       Begin DoDot:2

 +11      ;

 +12      ; Check users currently on team:

 +13                       SET ORLPFRST=""

 +14                       SET ORLPCNT=0

 +15                       SET ORLPUSER=0

 +16                       FOR 

                               SET ORLPUSER=$ORDER(^OR(100.21,+ORLPTEAM,1,ORLPUSER))

                               IF +ORLPUSER=0

                                   QUIT 

                               Begin DoDot:3

 +17      ; Increment counter.

                                   SET ORLPCNT=ORLPCNT+1

 +18      ; Get first user.

                                   IF ORLPCNT=1

                                       SET ORLPFRST=ORLPUSER

 +19      ; If more than one user, punt.

                                   IF ORLPCNT>1

                                       QUIT 

                               End DoDot:3

 +20      ;

 +21      ; Check for none or only one user:

 +22                       IF ORLPCNT=0!'(ORLPFRST="")

                               Begin DoDot:3

 +23      ;

 +24      ; Find out if user is terminated:

 +25                               IF ORLPCNT=0!'($$ACTIVE^XUSER(+ORLPFRST))

                                       Begin DoDot:4

 +26      ; Get name of Team List.

                                           SET ORLPTNM=$PIECE(^OR(100.21,ORLPTEAM,0),U,1)

 +27      ;

 +28      ; Dump team if of type "Personal" (and only user is terminated):

 +29      ; Handle file locking.

                                           LOCK +^OR(100.21,+ORLPTEAM):3

 +30                                       SET DIK="^OR(100.21,"

 +31                                       SET DA=+ORLPTEAM

 +32      ; Delete the Team List.

                                           DO ^DIK

 +33      ; Clean up after call to DIK.

                                           KILL DIK,DA,Y,%

 +34      ; Unlock the file.

                                           LOCK -^OR(100.21,+ORLPTEAM)

 +35      ; Installation message to run under Taskman.

                                           DO MES^XPDUTL("Personal Team "_ORLPTNM_" / IEN "_+ORLPTEAM_" deleted.")

 +36      ;

 +37      ; Call Consults package code to delete pointers there:

 +38                                       DO CLNLIST^GMRCTU(+ORLPTEAM,1)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +39      ;

 +40       QUIT 

 +41      ;