OOPSSOF2.m

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 ---OOPSSOF2   1047     printed  Apr 23, 2025@17:54:06                                                                                                                                                                                                    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