OOPSSOF2 ;HINES/WAA-SOF/E Safety officer CLOSE Routine ;3/30/98
;;2.0;ASISTS;;Jun 03, 2002
;;
EN1 ; Main Entry Point
N DIC,SSN,IEN,CLOSED,FORM,SIGN
S IEN=0
D Q:IEN<1
.N DIC,X
.S DIC="^OOPS(2260,"
.S DIC(0)="AEMNZ",DIC("S")="I $$GET1^DIQ(2260,Y,51,""I"")'=3",DIC("A")="Select Case: "
.D ^DIC
.Q:Y<1
.Q:$D(DTOUT)!($D(DUOUT))
.S IEN=$P(Y,U)
.Q
CLOSE ; Close
N DR,DIE,SIGN2,CURSTAT,DIR
D ^OOPSDIS
S CURSTAT=$$GET1^DIQ(2260,IEN,51,"E")
S DIR(0)="SAO^0:Open;1:Closed;2:Deleted"
S DIR("A")=" CASE STATUS.................."
S DIR("B")=$S(CURSTAT'="":$E(CURSTAT,1),1:"C") D ^DIR
I $D(DIRUT) Q
S DR=""
; Patch 5 - Clear Field 57 when needed
I CURSTAT="Closed" D
. I $$EXTERNAL^DILFD(2260,51,,Y)["Deleted" Q ; Perserve Date
. I $$EXTERNAL^DILFD(2260,51,,Y)'[CURSTAT D
.. S DR(1,2260,2)="57////@"
S DR(1,2260,1)="51////"_Y
I Y=2 D
.S DR(1,2260,2)="58 REASON FOR DELETION........."
S DIE="^OOPS(2260,",DA=IEN
D ^DIE
K SUP ; patch 8 - clean up var from OOPSDIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSSOF2 1047 printed Dec 13, 2024@01:39:39 Page 2
OOPSSOF2 ;HINES/WAA-SOF/E Safety officer CLOSE Routine ;3/30/98
+1 ;;2.0;ASISTS;;Jun 03, 2002
+2 ;;
EN1 ; Main Entry Point
+1 NEW DIC,SSN,IEN,CLOSED,FORM,SIGN
+2 SET IEN=0
+3 Begin DoDot:1
+4 NEW DIC,X
+5 SET DIC="^OOPS(2260,"
+6 SET DIC(0)="AEMNZ"
SET DIC("S")="I $$GET1^DIQ(2260,Y,51,""I"")'=3"
SET DIC("A")="Select Case: "
+7 DO ^DIC
+8 if Y<1
QUIT
+9 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+10 SET IEN=$PIECE(Y,U)
+11 QUIT
End DoDot:1
if IEN<1
QUIT
CLOSE ; Close
+1 NEW DR,DIE,SIGN2,CURSTAT,DIR
+2 DO ^OOPSDIS
+3 SET CURSTAT=$$GET1^DIQ(2260,IEN,51,"E")
+4 SET DIR(0)="SAO^0:Open;1:Closed;2:Deleted"
+5 SET DIR("A")=" CASE STATUS.................."
+6 SET DIR("B")=$SELECT(CURSTAT'="":$EXTRACT(CURSTAT,1),1:"C")
DO ^DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET DR=""
+9 ; Patch 5 - Clear Field 57 when needed
+10 IF CURSTAT="Closed"
Begin DoDot:1
+11 ; Perserve Date
IF $$EXTERNAL^DILFD(2260,51,,Y)["Deleted"
QUIT
+12 IF $$EXTERNAL^DILFD(2260,51,,Y)'[CURSTAT
Begin DoDot:2
+13 SET DR(1,2260,2)="57////@"
End DoDot:2
End DoDot:1
+14 SET DR(1,2260,1)="51////"_Y
+15 IF Y=2
Begin DoDot:1
+16 SET DR(1,2260,2)="58 REASON FOR DELETION........."
End DoDot:1
+17 SET DIE="^OOPS(2260,"
SET DA=IEN
+18 DO ^DIE
+19 ; patch 8 - clean up var from OOPSDIS
KILL SUP
+20 QUIT
