source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSSOF2.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1011 bytes
RevLine 
[613]1OOPSSOF2 ;HINES/WAA-SOF/E Safety officer CLOSE Routine ;3/30/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4EN1 ; Main Entry Point
5 N DIC,SSN,IEN,CLOSED,FORM,SIGN
6 S IEN=0
7 D Q:IEN<1
8 .N DIC,X
9 .S DIC="^OOPS(2260,"
10 .S DIC(0)="AEMNZ",DIC("S")="I $$GET1^DIQ(2260,Y,51,""I"")'=3",DIC("A")="Select Case: "
11 .D ^DIC
12 .Q:Y<1
13 .Q:$D(DTOUT)!($D(DUOUT))
14 .S IEN=$P(Y,U)
15 .Q
16CLOSE ; Close
17 N DR,DIE,SIGN2,CURSTAT,DIR
18 D ^OOPSDIS
19 S CURSTAT=$$GET1^DIQ(2260,IEN,51,"E")
20 S DIR(0)="SAO^0:Open;1:Closed;2:Deleted"
21 S DIR("A")=" CASE STATUS.................."
22 S DIR("B")=$S(CURSTAT'="":$E(CURSTAT,1),1:"C") D ^DIR
23 I $D(DIRUT) Q
24 S DR=""
25 ; Patch 5 - Clear Field 57 when needed
26 I CURSTAT="Closed" D
27 . I $$EXTERNAL^DILFD(2260,51,,Y)["Deleted" Q ; Perserve Date
28 . I $$EXTERNAL^DILFD(2260,51,,Y)'[CURSTAT D
29 .. S DR(1,2260,2)="57////@"
30 S DR(1,2260,1)="51////"_Y
31 I Y=2 D
32 .S DR(1,2260,2)="58 REASON FOR DELETION........."
33 S DIE="^OOPS(2260,",DA=IEN
34 D ^DIE
35 K SUP ; patch 8 - clean up var from OOPSDIS
36 Q
Note: See TracBrowser for help on using the repository browser.