source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSCNV1.m@ 711

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1QAOSCNV1 ;HISC/DAD-DELETE OLD OCCURRENCE SCREEN FILES/FIELDS ;8/10/93 10:12
2 ;;3.0;Occurrence Screen;;09/14/1993
3 S QAOSDD(0)=0 F QAOSDD=513.73:.01:513.79 S X=$P($G(^DIC(QAOSDD,0)),"^"),QAOSDD(QAOSDD)=(X]"")_"^"_QAOSDD_"^"_$S(X]"":X,1:"") S:X]"" QAOSDD(0)=1
4 S QAOSFLD(0)=0 F QAOFFSET=1:1 S QAOSFLD=$P($T(FLDS+QAOFFSET),";",3) Q:QAOSFLD="" S X=$G(^DD(513.72,+QAOSFLD,0)),QAOSFLD(+QAOSFLD)=(X]"")_"^"_$P(X,"^")_"^"_$P(QAOSFLD,"^",2) S:X]"" QAOSFLD(0)=1
5 G:(QAOSDD(0)'>0)&(QAOSFLD(0)'>0) 740
6 W !!,"Delete version 1.01 Occurrence Screen files/fields"
7 W !,"--------------------------------------------------",!
8 D SHOWFILE:QAOSDD(0),SHOWFLDS:QAOSFLD(0)
9ASKDEL ;
10 W !!,"Are you sure you want to continue" S %=2 D YN^DICN
11 I (%=-1)!(%=2) D G EXIT
12 . W *7,!!!?24,"*** EXITING THE INIT PROCESS ***"
13 . W !!?12,"Occurrence Screen V3.0 may not be installed until after"
14 . W !?14,"the successful completion of the pre-init routine !!",*7
15 . K DIFQ
16 . Q
17 I '% D G ASKDEL
18 . W !!?5,"Answer Y(es) to delete the items displayed,"
19 . W !?5,"and continue with the installation."
20 . W !!?5,"Answering N(o) will leave the files untouched"
21 . W !?5,"and abort the installation."
22 . D SHOWFILE:QAOSDD(0),SHOWFLDS:QAOSFLD(0)
23 . Q
24 D DELFILE:QAOSDD(0),DELFLDS:QAOSFLD(0)
25740 ;
26 I $D(^DD(740,741.97,0))[0,$D(^DD(740,741.98,0))[0 G 741
27 W !!,"Delete OS/2.5 temporary conversion fields from file #740"
28 W !,"--------------------------------------------------------",!
29 W !?5,"Field: 741.97 - ",$P($G(^DD(740,741.97,0)),"^")
30 S DIK="^DD(740,",DA=741.97,DA(1)=740 D ^DIK
31 W !?5,"Field: 741.98 - ",$P($G(^DD(740,741.98,0)),"^")
32 S DIK="^DD(740,",DA=741.98,DA(1)=740 D ^DIK K ^QA(740,1,"QAO")
33741 ;
34 I $D(^QA(741,"AF"))[0 G 107
35 W !!,"Kill the 'AC', 'AF' and 'AE' cross references in file #741"
36 W !,"----------------------------------------------------------",!
37 K DA,DIK S DIK="^DD(741.01,9,1,",DA(2)=741.01,DA(1)=9,DA=1
38 W !?5,"Xref: 'AC'" D ^DIK W " killed"
39 K DA,DIK S DIK="^DD(741,2,1,",DA(2)=741,DA(1)=2,DA=1
40 W !?5,"Xref: 'AF'" D ^DIK K ^QA(741,"AF") W " killed"
41 K DA,DIK S DIK="^DD(741,14,1,",DA(2)=741,DA(1)=14,DA=3
42 W !?5,"Xref: 'AE'" D ^DIK W " killed"
43107 ;
44 I $D(^QA(741.1,107,0))[0 G EXIT
45 W !!,"Convert screen 107 to return to O.R. within 7 days"
46 W !,"--------------------------------------------------",!
47 S QA="UNPLANNED RETURN TO OR IN SAME ADMISSION, OR WITHIN 7 DAYS OF OPERATION"
48 W !?5,QA
49 K DA,DIE,DR S DIE="^QA(741.1,",DA=107,DR="2///"_QA
50 D ^DIE
51EXIT ;
52 K %,DA,DIC,DIK,DIU,QAOFFSET,QAOSDD,QAOSFLD,X,Y
53 Q
54SHOWFILE ;
55 W !!,"The following files are about to be deleted:",!
56 F QAOSDD=513.73:.01:513.79 W:QAOSDD(QAOSDD) !?5,QAOSDD,?14,$P(QAOSDD(QAOSDD),"^",3)
57 Q
58DELFILE ;
59 W !!,"Deleting files:",!
60 F QAOSDD=513.73:.01:513.79 D
61 . Q:QAOSDD(QAOSDD)'>0
62 . W !?5,QAOSDD,?14,$P(QAOSDD(QAOSDD),"^",3)
63 . S DIU=QAOSDD,DIU(0)="DT" D EN^DIU2
64 . Q
65 Q
66SHOWFLDS ;
67 W !!,"The following fields in the PATIENT QA EVENT file (#513.72)",!,"are about to be deleted:",!
68 F QAOSFLD=0:0 S QAOSFLD=$O(QAOSFLD(QAOSFLD)) Q:QAOSFLD'>0 D
69 . S X=QAOSFLD(QAOSFLD)
70 . I X W !?5,QAOSFLD,?14,$P(X,"^",2),$S($P(X,"^",3)="M":" (Mult)",1:"")
71 . Q
72 Q
73DELFLDS ;
74 W !!,"Deleting fields in the PATIENT QA EVENT file (#513.72):",!
75 F QAOSFLD=0:0 S QAOSFLD=$O(QAOSFLD(QAOSFLD)) Q:QAOSFLD'>0 D
76 . S X=QAOSFLD(QAOSFLD) Q:X'>0
77 . W !?5,QAOSFLD,?14,$P(X,"^",2),$S($P(X,"^",3)="M":" (Mult)",1:"")
78 . I $P(X,"^",3)="M" D
79 .. S DIU=+$P(^DD(513.72,QAOSFLD,0),"^",2),DIU(0)="DS" D EN^DIU2
80 .. Q
81 . E D
82 .. S DIK="^DD(513.72,",DA=QAOSFLD,DA(1)=513.72 D ^DIK
83 .. Q
84 . Q
85 Q
86FLDS ;;FIELDS IN 513.72 TO BE DELETED ^ 'M' IF FIELD IS MULTIPLE
87 ;;9
88 ;;10
89 ;;12
90 ;;13
91 ;;14
92 ;;15.5
93 ;;30
94 ;;31
95 ;;32
96 ;;32.5
97 ;;33
98 ;;33.5
99 ;;34
100 ;;35^M
101 ;;42
102 ;;43
103 ;;44
104 ;;45
105 ;;46
106 ;;48
107 ;;49
108 ;;52
109 ;;53^M
110 ;;71
111 ;;73
112 ;;74^M
113 ;;74.5^M
Note: See TracBrowser for help on using the repository browser.