source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRI19.m@ 824

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1SPNPRI19 ;SD/CM/Pre init action for patch 19; 1/16/2003 14:23
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3EN ;
4 S U="^"
5 Q:$G(^DD(154.1,1003,0))'="" ; early quit if patch 19 prev installed
6 Q:'+$P($G(^SPNL(154.1,0)),U,4) ; early quit if no outcomes on file
7 S SPNCNT=0,SPNCT=0,SPNK=0,SPNXMT=0,SPNBTOT=$O(^SPNL(154.1," "),-1)
8 G:$P($G(^SPNL(154.7,+$$SITE^VASITE,0)),U,5)'="" ENREI ; just re-index
9 ; Delete obsolete "XMT" nodes and convert Record Type data
10 W !,"Please stand by while I remove an obsolete data node and update"
11 W !,"the Record Type field in the Outcomes file (#154.1).",!!
12 S SPNAIEN=SPNBTOT ; holds the cumulative last ien when adding records
13 S SPNIEN=0 F S SPNIEN=$O(^SPNL(154.1,SPNIEN)) Q:SPNIEN=SPNBTOT D FIND,CHART,FAM,DIENER,DUSOI,KILLS,RESASIA
14 S SPNIEN=SPNBTOT D FIND,CHART,FAM,DIENER,DUSOI,KILLS,RESASIA
15ENREI W !,"Please stand by while I re-index the Outcomes file (#154.1).",!!
16 S SPNIEN=0 F S SPNIEN=$O(^SPNL(154.1,SPNIEN)) Q:'+SPNIEN D REIND
17 S $P(^SPNL(154.1,0),U,3)=$O(^SPNL(154.1," "),-1)
18 S $P(^SPNL(154.1,0),U,4)=SPNCT
19 W !,"D o n e! ",SPNCNT," entries have been processed, resulting in"
20 W !,SPNK," new entries created by the splitting of CHART/FAM/DIENER/DUSOI"
21 W !,"into separate Record Types."
22 W !,"Also, ",SPNXMT," obsolete XMT nodes were removed."
23 G EXIT
24FIND ;
25 S SPNCNT=SPNCNT+1 I SPNCNT#40=0 W "."
26 I SPNCNT#610=0 W "Working"
27 I +$G(SPNIEN),$D(^SPNL(154.1,SPNIEN,"XMT")) K ^SPNL(154.1,SPNIEN,"XMT") S SPNXMT=SPNXMT+1
28 ; begin converting record type number, starting with MS (4 to 8)
29 S $P(^SPNL(154.7,+$$SITE^VASITE,0),U,5)=SPNIEN ; stores last ien processed
30 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=4 S $P(^SPNL(154.1,SPNIEN,0),U,2)=8
31 ; now store ASIA temporarily as a 9
32 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=5 S $P(^SPNL(154.1,SPNIEN,0),U,2)=9
33 Q
34 ; create new entries for the various 'CHART' record types
35CHART ;
36 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=3,$D(^SPNL(154.1,SPNIEN,"CHART")) D ADDCRT
37 Q
38FAM ;
39 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=3,$D(^SPNL(154.1,SPNIEN,"FAM")) D ADDFAM
40 Q
41DIENER ;
42 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=3,$D(^SPNL(154.1,SPNIEN,"SCORE")),+$P($G(^SPNL(154.1,SPNIEN,"SCORE")),U,1) D ADDDEN
43 Q
44DUSOI ;
45 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=3,$D(^SPNL(154.1,SPNIEN,"SCORE")),+$P($G(^SPNL(154.1,SPNIEN,"SCORE")),U,2) D ADDDUS
46 Q
47KILLS ; now kill the old data nodes belonging to CHART Record Type (no dups)
48 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=3,$D(^SPNL(154.1,SPNIEN,"CHART")) D KILLOLD
49 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=3,$D(^SPNL(154.1,SPNIEN,"FAM")) D KILLOLD
50 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=3,$D(^SPNL(154.1,SPNIEN,"SCORE")) D KILLOLD
51 Q
52RESASIA ; now restore ASIA from 9 to 3
53 I $P($G(^SPNL(154.1,SPNIEN,0)),U,2)=9 S $P(^SPNL(154.1,SPNIEN,0),U,2)=3
54 Q
55ADDCRT ;
56 S SPNK=SPNK+1,SPNAIEN=SPNAIEN+1
57 S SPNMOV(0)=^SPNL(154.1,SPNIEN,0)
58 S:$D(^SPNL(154.1,SPNIEN,2)) SPNMOV(2)=^SPNL(154.1,SPNIEN,2)
59 S:$D(^SPNL(154.1,SPNIEN,8)) SPNMOV(8)=^SPNL(154.1,SPNIEN,8)
60 S SPNMOV("CHART")=^SPNL(154.1,SPNIEN,"CHART")
61 S %X="SPNMOV(",%Y="^SPNL(154.1,SPNAIEN," D %XY^%RCR
62 S $P(^SPNL(154.1,SPNAIEN,0),U,2)=4
63 K SPNMOV
64 Q
65ADDFAM ;
66 S SPNK=SPNK+1,SPNAIEN=SPNAIEN+1
67 S SPNMOV(0)=^SPNL(154.1,SPNIEN,0)
68 S:$D(^SPNL(154.1,SPNIEN,2)) SPNMOV(2)=^SPNL(154.1,SPNIEN,2)
69 S:$D(^SPNL(154.1,SPNIEN,8)) SPNMOV(8)=^SPNL(154.1,SPNIEN,8)
70 S SPNMOV("FAM")=^SPNL(154.1,SPNIEN,"FAM")
71 S %X="SPNMOV(",%Y="^SPNL(154.1,SPNAIEN," D %XY^%RCR
72 S $P(^SPNL(154.1,SPNAIEN,0),U,2)=5
73 K SPNMOV
74 Q
75ADDDEN ;
76 S SPNK=SPNK+1,SPNAIEN=SPNAIEN+1
77 S SPNMOV(0)=^SPNL(154.1,SPNIEN,0)
78 S:$D(^SPNL(154.1,SPNIEN,2)) SPNMOV(2)=^SPNL(154.1,SPNIEN,2)
79 S:$D(^SPNL(154.1,SPNIEN,8)) SPNMOV(8)=^SPNL(154.1,SPNIEN,8)
80 S SPNMOV("SCORE")=^SPNL(154.1,SPNIEN,"SCORE")
81 S %X="SPNMOV(",%Y="^SPNL(154.1,SPNAIEN," D %XY^%RCR
82 S $P(^SPNL(154.1,SPNAIEN,0),U,2)=6
83 S $P(^SPNL(154.1,SPNAIEN,"SCORE"),U,2)=""
84 K SPNMOV
85 Q
86ADDDUS ;
87 S SPNK=SPNK+1,SPNAIEN=SPNAIEN+1
88 S SPNMOV(0)=^SPNL(154.1,SPNIEN,0)
89 S:$D(^SPNL(154.1,SPNIEN,2)) SPNMOV(2)=^SPNL(154.1,SPNIEN,2)
90 S:$D(^SPNL(154.1,SPNIEN,8)) SPNMOV(8)=^SPNL(154.1,SPNIEN,8)
91 S SPNMOV("SCORE")=^SPNL(154.1,SPNIEN,"SCORE")
92 S %X="SPNMOV(",%Y="^SPNL(154.1,SPNAIEN," D %XY^%RCR
93 S $P(^SPNL(154.1,SPNAIEN,0),U,2)=7
94 S $P(^SPNL(154.1,SPNAIEN,"SCORE"),U,1)=""
95 K SPNMOV
96 Q
97REIND ; reindex entire file, all cross references, all entries
98 S SPNCT=SPNCT+1
99 S DIK="^SPNL(154.1,",DA=SPNIEN D IX^DIK
100 Q
101KILLOLD ;
102 S DIK="^SPNL(154.1,",DA=SPNIEN D ^DIK
103 Q
104EXIT ;
105 K DA,DIK
106 K SPNIEN,SPNAIEN,SPNCNT,SPNCT,SPNK,SPNBTOT,SPNMOV,SPNXMT
107 Q
Note: See TracBrowser for help on using the repository browser.