source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSCA.m@ 699

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1OOPSCA ;HINES CIOFO/GWB-CREATE ASISTS AMENDMENT ;3/5/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3 N DLAYGO
4SUP S DIC="^OOPS(2260,",DIC("S")="I ($P(^OOPS(2260,Y,0),U,8)=DUZ)!($P(^OOPS(2260,Y,0),U,9)=DUZ),$P(^OOPS(2260,Y,0),U,6)=0" G DIC
5SO S DIC="^OOPS(2260,",DIC("S")="I $P(^OOPS(2260,Y,0),U,6)=0"
6DIC S DIC(0)="AEMNZ",DIC("A")="Select case to be amended: "
7 D ^DIC Q:(Y<1)!($D(DTOUT))!($D(DUOUT))
8 S OLDIEN=$P(Y,U),NUM=$P(^OOPS(2260,OLDIEN,0),U,1),SUF=$E(NUM,11)
9 S $P(^OOPS(2260,OLDIEN,0),U,6)=3
10 S NUM=$E(NUM,1,10)_$S(SUF="":"A",1:$CHAR($ASCII(SUF)+1))
11 S DLAYGO=2260
12 K DD,DO S DIC="^OOPS(2260,",DIC(0)="QLZ",X=NUM D FILE^DICN G:Y=-1 EXIT
13 S NEWIEN=+Y
14 MERGE ^OOPS(2260,NEWIEN)=^OOPS(2260,OLDIEN)
15 ; patch 11 - set global into variable to use, set field 57 to ""
16 ; so case can be resent to NDB
17 S OOP=^OOPS(2260,NEWIEN,0)
18 S $P(OOP,U,1)=NUM,$P(OOP,U,6)=0,$P(OOP,U,11)="",$P(OOP,U,19)=""
19 S ^OOPS(2260,NEWIEN,0)=OOP
20 S $P(^OOPS(2260,NEWIEN,"CA"),U,6)=""
21 S DIK="^OOPS(2260,",DA=NEWIEN D IX^DIK
22 K ^OOPS(2260,NEWIEN,"2162ES")
23 K ^OOPS(2260,NEWIEN,"CA1ES")
24 K ^OOPS(2260,NEWIEN,"CA2ES")
25 ; Clean up DOL cross reference - PATCH 8
26 N IEN,X,WCPDUZ,WOK
27 S WCPDUZ=$P($G(^OOPS(2260,NEWIEN,"WCES")),U)
28 I $G(WCPDUZ) S WOK=1,X=WCPDUZ,IEN=OLDIEN D WK^OOPSUTL1
29 K ^OOPS(2260,NEWIEN,"WCES")
30 W !!,"Case number ",NUM," has been assigned to this amended incident."
31 W !,"Use option ""Edit Report of Incident"" to complete this case."
32EXIT K DIC,OLDIEN,NEWIEN,NUM,SUF,X,Y,DIK,OOP
33 Q
Note: See TracBrowser for help on using the repository browser.