OOPSGUI0 ;WIOFO/LLH-RPC routines ;01/02/02
;;2.0;ASISTS;**2,4,7,15**;Jun 03, 2002;Build 9
;
GETCASE(RESULTS,PERSON,CSTAT,PSTAT,CALL,OPT) ; Subroutine for Case Selection
; Returns a list of cases that can be displayed for selection
; RESULTS = return array containing, CASE#^IEN^NAME^DATE TIME OCCUR
; PERSON = 0^ if no person selected
; 1^PERSON INVOLVED NAME
; 2^SUPERVISOR DUZ
; 3^USER SSN
; 4^CASE NUMBER
; CSTAT = #^#^#^# 0^1^2^3 0=open, 1=closed, 2=deleted, 3=replaced
; 99^ if all Case Status should be included
; CSTAT is only set programatically
; PSTAT = 0^ if all personnel status types should be included
; #^#^#^ for each personnel status selected
; CALL = Calling menu, used to assure proper access
; OPT = Option called from, used to assure proper access
;
K ^TMP("OOPSCASE",DUZ)
N ARR,CNUM,OOPSDA,PER,STA,SUP,VIEWSUP,VIEWEMP,VALSSN
I $G(PERSON)="" Q
I +PERSON=1 D GETPER,SORT G EXIT
I +PERSON=4 D G EXIT
. S CNUM=$P($G(PERSON),U,2) I '$G(CNUM) Q
. S OOPSDA=$O(^OOPS(2260,"B",CNUM,"")) I '$G(OOPSDA) D Q
.. S ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable"
.. S RESULTS=$NA(^TMP("OOPSCASE",DUZ))
..; S RESULTS(0)="No Cases Selectable"
. S STA=$$GET1^DIQ(2260,OOPSDA,51,"I")
. I +CSTAT'=99,(CSTAT'[STA_"^") Q ;allow only selected case status
. I $$CALLER() S ARR(CNUM)=OOPSDA
. D SORT
S CNUM=0
F S CNUM=$O(^OOPS(2260,"B",CNUM)) Q:CNUM="" D
. S OOPSDA=""
. F S OOPSDA=$O(^OOPS(2260,"B",CNUM,OOPSDA)) Q:OOPSDA="" D
.. I +PERSON=3 D Q:'VIEWEMP
... S VIEWEMP=1,VALSSN=$P($G(PERSON),U,2)
... I $$GET1^DIQ(2260,OOPSDA,5,"I")'=VALSSN D
.... S VIEWEMP=0
.... S ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable"
.... S RESULTS=$NA(^TMP("OOPSCASE",DUZ))
.. S STA=$$GET1^DIQ(2260,OOPSDA,51,"I")
.. I +CSTAT'=99,(CSTAT'[STA_"^") Q ;allow only selected case status
.. S PER=$$GET1^DIQ(2260,OOPSDA,2,"I")
.. I (+PSTAT)&(PSTAT'[(PER_"^")) Q ;allow only selected per status
.. I +PERSON=2 D Q:'VIEWSUP
... S VIEWSUP=1,SUP=$P(PERSON,U,2)
... I $$GET1^DIQ(2260,OOPSDA,53,"I")'=SUP,($$GET1^DIQ(2260,OOPSDA,53.1,"I")'=SUP) D Q
....; S RESULTS(0)="No Cases Selectable",VIEWSUP=0
.... S ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable",VIEWSUP=0
.... S RESULTS=$NA(^TMP("OOPSCASE",DUZ))
.. I $$CALLER() S CNUM=$$GET1^DIQ(2260,OOPSDA,.01),ARR(CNUM)=OOPSDA
D SORT
EXIT ; quit the routine
Q
GETPER ; Person Name passed in, match
; See above for documentation
N NM
S OOPSDA="",NM=$P(PERSON,U,2)
F S OOPSDA=$O(^OOPS(2260,"C",NM,OOPSDA)) Q:OOPSDA="" D
. S STA=$$GET1^DIQ(2260,OOPSDA,51,"I")
. I +CSTAT'=99,(CSTAT'[STA_"^") Q ;allow only selected case status
. S PER=$$GET1^DIQ(2260,OOPSDA,2,"I")
. I (+PSTAT)&(PSTAT'[(PER_"^")) Q ;allow only selected per status
. I $$CALLER() S CNUM=$$GET1^DIQ(2260,OOPSDA,.01),ARR(CNUM)=OOPSDA
Q
CALLER() ; Check to make sure case should be included
N EES,ESTAT,FLD,INC,SIG,SSN,VIEWC
S VIEWC=1
S INC=$$GET1^DIQ(2260,OOPSDA,52,"I")
; get users SSN
S SSN=$$GET1^DIQ(200,DUZ,9)
; make sure user cannot access claim from any menu but Employee
I CALL'="E",($$GET1^DIQ(2260,OOPSDA,5,"I")=SSN) S VIEWC=0 Q VIEWC
; Claim already sent to DOL, can't edit, Caller / Option doesnt matter
; unless the Option = "CHGCASE"
; Patch 4 llh - should also be able to create amendment. NOTE: Case
; status should always = open
; patch 7 llh - allow access if also opt=iocome
I ($$GET1^DIQ(2260,OOPSDA,66)'=""),(OPT'="CHGCASE"),(OPT'="PRINTCA"),(OPT'=2162),(OPT'="CRAMEND"),(OPT'="IOCOME") S VIEWC=0 Q VIEWC
; for any option from the supervisor menu
I CALL="S" D I 'VIEWC Q VIEWC
. I $$GET1^DIQ(2260,OOPSDA,53,"I")'=DUZ,($$GET1^DIQ(2260,OOPSDA,53.1,"I")'=DUZ) S VIEWC=0 Q
; if opt = 2162
I OPT=2162 D Q VIEWC
. I $$GET1^DIQ(2260,OOPSDA,51,"I")=1 S VIEWC=0 ; closed, can't edit
. ; signed SO, coming from Supervisor menu, cant access
. I (CALL="S"),+$$EDSTA^OOPSUTL1(OOPSDA,"O") S VIEWC=0
. I CALL="H" D
.. I $P($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,3)!(+$$EDSTA^OOPSUTL1(OOPSDA,"O")) S VIEWC=0
. I CALL="W" D
.. I +$$EDSTA^OOPSUTL1(OOPSDA,"O") S VIEWC=0 ;safety signed cant see
; if opt = CA1 only return/allow CA1's, caller doesnt matter
I OPT="CA1",INC'=1 S VIEWC=0 Q VIEWC
; if opt = CA2 only return/allow CA2's, caller doesnt matter
I OPT="CA2",INC'=2 S VIEWC=0 Q VIEWC
I CALL="E" D Q VIEWC
. I '$$ISEMP^OOPSUTL4(OOPSDA) S VIEWC=0 Q
. I '$G(SSN) S VIEWC=0 Q
. I $D(^OOPS(2260,"SSN",SSN))<1 S VIEWC=0 Q
. ; user SSN must = case IEN from Employee menu
. I $$GET1^DIQ(2260,OOPSDA,5,"I")'=SSN S VIEWC=0 Q
. S SIG=$$EDSTA^OOPSUTL1(OOPSDA,"S")
. I (OPT'="PRINTCA"),$P(SIG,U,INC) S VIEWC=0 Q
I CALL="S" D Q VIEWC
. ; not Super or Sec Super, can't access form, regardless of form type
. I $$GET1^DIQ(2260,OOPSDA,53,"I")'=DUZ&($$GET1^DIQ(2260,OOPSDA,53.1,"I")'=DUZ) S VIEWC=0 Q
. ; Supervisor cannot complete their own form.
. I $$GET1^DIQ(2260,OOPSDA,5,"I")=SSN S VIEWC=0 Q
. I OPT="CA1"!(OPT="CA2") D Q
.. ; if form CA, must be employee to complete
.. I '$$ISEMP^OOPSUTL4(OOPSDA) S VIEWC=0 Q
.. ; commented out next 2 lines, ? whether wanted by TAG 11/1/01 llh
.. ; Employee hasn't signed, super can't get to
.. ; I '$P($$EDSTA^OOPSUTL1(OOPSDA,"E"),U,INC) S VIEWC=0 Q
.. ; Supervisor has signed, can't re-edit
.. I $P($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,INC) S VIEWC=0 Q
I CALL="O"!(CALL="W")!(CALL="H") D Q VIEWC
. I OPT="CA1"!(OPT="CA2") D Q
.. I '$$ISEMP^OOPSUTL4(OOPSDA) S VIEWC=0 Q
. I OPT="WCSIGN" D Q
.. S ESTAT=$$EDSTA^OOPSUTL1(OOPSDA,"E")
.. I '$$ISEMP^OOPSUTL4(OOPSDA) S VIEWC=0 Q
.. I CALL'="W",$P(ESTAT,U,INC) S VIEWC=0 Q
.. I CALL="W" D
... S FLD=$S(INC=1:119,INC=2:221,1:"") I 'FLD S VIEWC=0 Q
... S EES=$$GET1^DIQ(2260,OOPSDA,FLD,"I")
... ; employee hasn't signed, ok for WC to sign
... I 'EES Q
... ; employee signed, not signed by person accessing claim, no access
... I EES'=DUZ S VIEWC=0 Q
... I $P($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,INC) S VIEWC=0 ;Sup Sign, no acc
. I OPT="WCEMPSIGN" D Q
.. N CALLER,SVIEW
.. S CALLER=CALL
.. I $$GET1^DIQ(2260,OOPSDA,51,"I") S VIEWC=0 Q ; claim must be open
.. ;V2_P15 02/13/08 llh - remove requirement Safety or Occ Health must sign first
.. ;I $$GET1^DIQ(2260,OOPSDA,77)="" S VIEWC=0 Q
.. ;I $$GET1^DIQ(2260,OOPSDA,80)="" S VIEWC=0 Q
.. S SVIEW=$$SCR^OOPSWCSE(OOPSDA) I 'SVIEW S VIEWC=0 Q
I CALL="U" D Q VIEWC
. I '+$$EDSTA^OOPSUTL1(OOPSDA,"O") S VIEWC=0 Q
. I '$P($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,3) S VIEWC=0 Q
Q VIEWC
SORT ; put cases in reverse number order
N CN,CNUM,OOPSDA,SSN,DOI
S ^TMP("OOPSCASE",DUZ,0)="",CNUM="",CN=1
I '$D(ARR) S RESULTS(0)="No Cases Selectable" D
. S ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable",VIEWSUP=0
. S RESULTS=$NA(^TMP("OOPSCASE",DUZ))
F S CNUM=$O(ARR(CNUM),-1) Q:CNUM="" D
. S OOPSDA=ARR(CNUM)
. S NM=$$GET1^DIQ(2260,OOPSDA,1)
. S DOI=$$GET1^DIQ(2260,OOPSDA,4)
. S SSN=$$GET1^DIQ(2260,OOPSDA,5)
. I CALL="U" S (NM,DOI,SSN)=""
. S ^TMP("OOPSCASE",DUZ,CN)=CNUM_U_DOI_U_NM_U_OOPSDA_U_SSN_$C(10),CN=CN+1
S RESULTS=$NA(^TMP("OOPSCASE",DUZ))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSGUI0 7260 printed Dec 13, 2024@01:38:58 Page 2
OOPSGUI0 ;WIOFO/LLH-RPC routines ;01/02/02
+1 ;;2.0;ASISTS;**2,4,7,15**;Jun 03, 2002;Build 9
+2 ;
GETCASE(RESULTS,PERSON,CSTAT,PSTAT,CALL,OPT) ; Subroutine for Case Selection
+1 ; Returns a list of cases that can be displayed for selection
+2 ; RESULTS = return array containing, CASE#^IEN^NAME^DATE TIME OCCUR
+3 ; PERSON = 0^ if no person selected
+4 ; 1^PERSON INVOLVED NAME
+5 ; 2^SUPERVISOR DUZ
+6 ; 3^USER SSN
+7 ; 4^CASE NUMBER
+8 ; CSTAT = #^#^#^# 0^1^2^3 0=open, 1=closed, 2=deleted, 3=replaced
+9 ; 99^ if all Case Status should be included
+10 ; CSTAT is only set programatically
+11 ; PSTAT = 0^ if all personnel status types should be included
+12 ; #^#^#^ for each personnel status selected
+13 ; CALL = Calling menu, used to assure proper access
+14 ; OPT = Option called from, used to assure proper access
+15 ;
+16 KILL ^TMP("OOPSCASE",DUZ)
+17 NEW ARR,CNUM,OOPSDA,PER,STA,SUP,VIEWSUP,VIEWEMP,VALSSN
+18 IF $GET(PERSON)=""
QUIT
+19 IF +PERSON=1
DO GETPER
DO SORT
GOTO EXIT
+20 IF +PERSON=4
Begin DoDot:1
+21 SET CNUM=$PIECE($GET(PERSON),U,2)
IF '$GET(CNUM)
QUIT
+22 SET OOPSDA=$ORDER(^OOPS(2260,"B",CNUM,""))
IF '$GET(OOPSDA)
Begin DoDot:2
+23 SET ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable"
+24 SET RESULTS=$NAME(^TMP("OOPSCASE",DUZ))
+25 ; S RESULTS(0)="No Cases Selectable"
End DoDot:2
QUIT
+26 SET STA=$$GET1^DIQ(2260,OOPSDA,51,"I")
+27 ;allow only selected case status
IF +CSTAT'=99
IF (CSTAT'[STA_"^")
QUIT
+28 IF $$CALLER()
SET ARR(CNUM)=OOPSDA
+29 DO SORT
End DoDot:1
GOTO EXIT
+30 SET CNUM=0
+31 FOR
SET CNUM=$ORDER(^OOPS(2260,"B",CNUM))
if CNUM=""
QUIT
Begin DoDot:1
+32 SET OOPSDA=""
+33 FOR
SET OOPSDA=$ORDER(^OOPS(2260,"B",CNUM,OOPSDA))
if OOPSDA=""
QUIT
Begin DoDot:2
+34 IF +PERSON=3
Begin DoDot:3
+35 SET VIEWEMP=1
SET VALSSN=$PIECE($GET(PERSON),U,2)
+36 IF $$GET1^DIQ(2260,OOPSDA,5,"I")'=VALSSN
Begin DoDot:4
+37 SET VIEWEMP=0
+38 SET ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable"
+39 SET RESULTS=$NAME(^TMP("OOPSCASE",DUZ))
End DoDot:4
End DoDot:3
if 'VIEWEMP
QUIT
+40 SET STA=$$GET1^DIQ(2260,OOPSDA,51,"I")
+41 ;allow only selected case status
IF +CSTAT'=99
IF (CSTAT'[STA_"^")
QUIT
+42 SET PER=$$GET1^DIQ(2260,OOPSDA,2,"I")
+43 ;allow only selected per status
IF (+PSTAT)&(PSTAT'[(PER_"^"))
QUIT
+44 IF +PERSON=2
Begin DoDot:3
+45 SET VIEWSUP=1
SET SUP=$PIECE(PERSON,U,2)
+46 IF $$GET1^DIQ(2260,OOPSDA,53,"I")'=SUP
IF ($$GET1^DIQ(2260,OOPSDA,53.1,"I")'=SUP)
Begin DoDot:4
+47 ; S RESULTS(0)="No Cases Selectable",VIEWSUP=0
+48 SET ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable"
SET VIEWSUP=0
+49 SET RESULTS=$NAME(^TMP("OOPSCASE",DUZ))
End DoDot:4
QUIT
End DoDot:3
if 'VIEWSUP
QUIT
+50 IF $$CALLER()
SET CNUM=$$GET1^DIQ(2260,OOPSDA,.01)
SET ARR(CNUM)=OOPSDA
End DoDot:2
End DoDot:1
+51 DO SORT
EXIT ; quit the routine
+1 QUIT
GETPER ; Person Name passed in, match
+1 ; See above for documentation
+2 NEW NM
+3 SET OOPSDA=""
SET NM=$PIECE(PERSON,U,2)
+4 FOR
SET OOPSDA=$ORDER(^OOPS(2260,"C",NM,OOPSDA))
if OOPSDA=""
QUIT
Begin DoDot:1
+5 SET STA=$$GET1^DIQ(2260,OOPSDA,51,"I")
+6 ;allow only selected case status
IF +CSTAT'=99
IF (CSTAT'[STA_"^")
QUIT
+7 SET PER=$$GET1^DIQ(2260,OOPSDA,2,"I")
+8 ;allow only selected per status
IF (+PSTAT)&(PSTAT'[(PER_"^"))
QUIT
+9 IF $$CALLER()
SET CNUM=$$GET1^DIQ(2260,OOPSDA,.01)
SET ARR(CNUM)=OOPSDA
End DoDot:1
+10 QUIT
CALLER() ; Check to make sure case should be included
+1 NEW EES,ESTAT,FLD,INC,SIG,SSN,VIEWC
+2 SET VIEWC=1
+3 SET INC=$$GET1^DIQ(2260,OOPSDA,52,"I")
+4 ; get users SSN
+5 SET SSN=$$GET1^DIQ(200,DUZ,9)
+6 ; make sure user cannot access claim from any menu but Employee
+7 IF CALL'="E"
IF ($$GET1^DIQ(2260,OOPSDA,5,"I")=SSN)
SET VIEWC=0
QUIT VIEWC
+8 ; Claim already sent to DOL, can't edit, Caller / Option doesnt matter
+9 ; unless the Option = "CHGCASE"
+10 ; Patch 4 llh - should also be able to create amendment. NOTE: Case
+11 ; status should always = open
+12 ; patch 7 llh - allow access if also opt=iocome
+13 IF ($$GET1^DIQ(2260,OOPSDA,66)'="")
IF (OPT'="CHGCASE")
IF (OPT'="PRINTCA")
IF (OPT'=2162)
IF (OPT'="CRAMEND")
IF (OPT'="IOCOME")
SET VIEWC=0
QUIT VIEWC
+14 ; for any option from the supervisor menu
+15 IF CALL="S"
Begin DoDot:1
+16 IF $$GET1^DIQ(2260,OOPSDA,53,"I")'=DUZ
IF ($$GET1^DIQ(2260,OOPSDA,53.1,"I")'=DUZ)
SET VIEWC=0
QUIT
End DoDot:1
IF 'VIEWC
QUIT VIEWC
+17 ; if opt = 2162
+18 IF OPT=2162
Begin DoDot:1
+19 ; closed, can't edit
IF $$GET1^DIQ(2260,OOPSDA,51,"I")=1
SET VIEWC=0
+20 ; signed SO, coming from Supervisor menu, cant access
+21 IF (CALL="S")
IF +$$EDSTA^OOPSUTL1(OOPSDA,"O")
SET VIEWC=0
+22 IF CALL="H"
Begin DoDot:2
+23 IF $PIECE($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,3)!(+$$EDSTA^OOPSUTL1(OOPSDA,"O"))
SET VIEWC=0
End DoDot:2
+24 IF CALL="W"
Begin DoDot:2
+25 ;safety signed cant see
IF +$$EDSTA^OOPSUTL1(OOPSDA,"O")
SET VIEWC=0
End DoDot:2
End DoDot:1
QUIT VIEWC
+26 ; if opt = CA1 only return/allow CA1's, caller doesnt matter
+27 IF OPT="CA1"
IF INC'=1
SET VIEWC=0
QUIT VIEWC
+28 ; if opt = CA2 only return/allow CA2's, caller doesnt matter
+29 IF OPT="CA2"
IF INC'=2
SET VIEWC=0
QUIT VIEWC
+30 IF CALL="E"
Begin DoDot:1
+31 IF '$$ISEMP^OOPSUTL4(OOPSDA)
SET VIEWC=0
QUIT
+32 IF '$GET(SSN)
SET VIEWC=0
QUIT
+33 IF $DATA(^OOPS(2260,"SSN",SSN))<1
SET VIEWC=0
QUIT
+34 ; user SSN must = case IEN from Employee menu
+35 IF $$GET1^DIQ(2260,OOPSDA,5,"I")'=SSN
SET VIEWC=0
QUIT
+36 SET SIG=$$EDSTA^OOPSUTL1(OOPSDA,"S")
+37 IF (OPT'="PRINTCA")
IF $PIECE(SIG,U,INC)
SET VIEWC=0
QUIT
End DoDot:1
QUIT VIEWC
+38 IF CALL="S"
Begin DoDot:1
+39 ; not Super or Sec Super, can't access form, regardless of form type
+40 IF $$GET1^DIQ(2260,OOPSDA,53,"I")'=DUZ&($$GET1^DIQ(2260,OOPSDA,53.1,"I")'=DUZ)
SET VIEWC=0
QUIT
+41 ; Supervisor cannot complete their own form.
+42 IF $$GET1^DIQ(2260,OOPSDA,5,"I")=SSN
SET VIEWC=0
QUIT
+43 IF OPT="CA1"!(OPT="CA2")
Begin DoDot:2
+44 ; if form CA, must be employee to complete
+45 IF '$$ISEMP^OOPSUTL4(OOPSDA)
SET VIEWC=0
QUIT
+46 ; commented out next 2 lines, ? whether wanted by TAG 11/1/01 llh
+47 ; Employee hasn't signed, super can't get to
+48 ; I '$P($$EDSTA^OOPSUTL1(OOPSDA,"E"),U,INC) S VIEWC=0 Q
+49 ; Supervisor has signed, can't re-edit
+50 IF $PIECE($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,INC)
SET VIEWC=0
QUIT
End DoDot:2
QUIT
End DoDot:1
QUIT VIEWC
+51 IF CALL="O"!(CALL="W")!(CALL="H")
Begin DoDot:1
+52 IF OPT="CA1"!(OPT="CA2")
Begin DoDot:2
+53 IF '$$ISEMP^OOPSUTL4(OOPSDA)
SET VIEWC=0
QUIT
End DoDot:2
QUIT
+54 IF OPT="WCSIGN"
Begin DoDot:2
+55 SET ESTAT=$$EDSTA^OOPSUTL1(OOPSDA,"E")
+56 IF '$$ISEMP^OOPSUTL4(OOPSDA)
SET VIEWC=0
QUIT
+57 IF CALL'="W"
IF $PIECE(ESTAT,U,INC)
SET VIEWC=0
QUIT
+58 IF CALL="W"
Begin DoDot:3
+59 SET FLD=$SELECT(INC=1:119,INC=2:221,1:"")
IF 'FLD
SET VIEWC=0
QUIT
+60 SET EES=$$GET1^DIQ(2260,OOPSDA,FLD,"I")
+61 ; employee hasn't signed, ok for WC to sign
+62 IF 'EES
QUIT
+63 ; employee signed, not signed by person accessing claim, no access
+64 IF EES'=DUZ
SET VIEWC=0
QUIT
+65 ;Sup Sign, no acc
IF $PIECE($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,INC)
SET VIEWC=0
End DoDot:3
End DoDot:2
QUIT
+66 IF OPT="WCEMPSIGN"
Begin DoDot:2
+67 NEW CALLER,SVIEW
+68 SET CALLER=CALL
+69 ; claim must be open
IF $$GET1^DIQ(2260,OOPSDA,51,"I")
SET VIEWC=0
QUIT
+70 ;V2_P15 02/13/08 llh - remove requirement Safety or Occ Health must sign first
+71 ;I $$GET1^DIQ(2260,OOPSDA,77)="" S VIEWC=0 Q
+72 ;I $$GET1^DIQ(2260,OOPSDA,80)="" S VIEWC=0 Q
+73 SET SVIEW=$$SCR^OOPSWCSE(OOPSDA)
IF 'SVIEW
SET VIEWC=0
QUIT
End DoDot:2
QUIT
End DoDot:1
QUIT VIEWC
+74 IF CALL="U"
Begin DoDot:1
+75 IF '+$$EDSTA^OOPSUTL1(OOPSDA,"O")
SET VIEWC=0
QUIT
+76 IF '$PIECE($$EDSTA^OOPSUTL1(OOPSDA,"S"),U,3)
SET VIEWC=0
QUIT
End DoDot:1
QUIT VIEWC
+77 QUIT VIEWC
SORT ; put cases in reverse number order
+1 NEW CN,CNUM,OOPSDA,SSN,DOI
+2 SET ^TMP("OOPSCASE",DUZ,0)=""
SET CNUM=""
SET CN=1
+3 IF '$DATA(ARR)
SET RESULTS(0)="No Cases Selectable"
Begin DoDot:1
+4 SET ^TMP("OOPSCASE",DUZ,1)="No Cases Selectable"
SET VIEWSUP=0
+5 SET RESULTS=$NAME(^TMP("OOPSCASE",DUZ))
End DoDot:1
+6 FOR
SET CNUM=$ORDER(ARR(CNUM),-1)
if CNUM=""
QUIT
Begin DoDot:1
+7 SET OOPSDA=ARR(CNUM)
+8 SET NM=$$GET1^DIQ(2260,OOPSDA,1)
+9 SET DOI=$$GET1^DIQ(2260,OOPSDA,4)
+10 SET SSN=$$GET1^DIQ(2260,OOPSDA,5)
+11 IF CALL="U"
SET (NM,DOI,SSN)=""
+12 SET ^TMP("OOPSCASE",DUZ,CN)=CNUM_U_DOI_U_NM_U_OOPSDA_U_SSN_$CHAR(10)
SET CN=CN+1
End DoDot:1
+13 SET RESULTS=$NAME(^TMP("OOPSCASE",DUZ))
+14 QUIT