source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSD40041.m@ 691

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1YSD40041 ;DALISC/LJA - Repoint Diag Results data continued... ;12/17/93 11:58 [ 04/08/94 12:01 PM ]
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;;
4 ;
5REP ; Repoint Diagnostic Results data (Called from ^YSD40040)
6 ;
7 ; Key Variables...
8 ; YSD4IEN -- req --> YSD4CFLG Conversion flag)
9 ; YSD4ND -- req (Original #;DIC(627.8, pointer. p(1) of ^(1))
10 ;
11 ; Set Conversion Entry flag...
12 S (YSD4CFLG,YSD4EREP)=0
13 ;
14 ; Repoint data here...
15 S YSD4NDN=$$NDN(+YSD4ND)
16 I 'YSD4NDN D QUIT ;->
17 . D NOW^%DTC
18 . D PED^YSD4E010(%,"New DSM # not found",627.8,"",+YSD4IEN,"",+$P($G(^YSD(627.8,+YSD4IEN,0)),U,2))
19 . S $P(^YSD(627.99,+YSD4CIEN,0),U,2)="E",YSD4EREP=1
20 ;
21 ; ^(0)
22 S YSD40=$G(^YSD(627.8,+YSD4IEN,0))
23 I YSD40']"" D QUIT ;->
24 . D NOW^%DTC
25 . D PED^YSD4E010(%,"Null 0 node",627.8,"",+YSD4IEN,"",+$P($G(^YSD(627.8,+YSD4IEN,0)),U,2))
26 . S $P(^YSD(627.99,+YSD4CIEN,0),U,2)="E",YSD4EREP=1
27 ;
28 ; ^(1)
29 S YSD41=$G(^YSD(627.8,+YSD4IEN,1)),YSD4COND=$P(YSD41,U,4)
30 I $P(YSD41,U)']"" D QUIT ;->
31 . D NOW^%DTC
32 . D PED^YSD4E010(%,"Null 1 node",627.8,"",+YSD4IEN,"",+$P($G(^YSD(627.8,+YSD4IEN,0)),U,2))
33 . S $P(^YSD(627.99,+YSD4CIEN,0),U,2)="E",YSD4EREP=1
34 ;
35 S YSD4REF=+YSD4NDN_";YSD(627.7,"
36 ;
37 ; Reset .01 0;1...
38 S $P(^YSD(627.8,+YSD4IEN,1),U)=YSD4REF
39 ;
40 ; Set XRef-required variables
41 S YSD4DFN=+$P(YSD40,U,2),YSD4DT=+$P(YSD40,U,3)
42 ;
43 ; AG Xref-required variables existent?
44 I YSD4DFN,YSD4ND D
45 . K ^YSD(627.8,"AG","D",+YSD4DFN,YSD4ND,+YSD4IEN)
46 . S ^YSD(627.8,"AG","D",+YSD4DFN,YSD4REF,+YSD4IEN)=""
47 ;
48 ; AE,AF Xref-required variables existent?
49 I YSD4DFN,YSD4ND,YSD4DT D
50 . K ^YSD(627.8,"AE","D",+YSD4DFN,+YSD4DT,YSD4ND,+YSD4IEN)
51 . S ^YSD(627.8,"AE","D",+YSD4DFN,+YSD4DT,YSD4REF,+YSD4IEN)=""
52 . K ^YSD(627.8,"AF",+YSD4DFN,9999999-YSD4DT,YSD4ND,+YSD4IEN)
53 . S ^YSD(627.8,"AF",+YSD4DFN,9999999-YSD4DT,YSD4REF,+YSD4IEN)=""
54 ;
55 ; AC Xref-required variables existent?
56 I YSD4DFN,YSD4ND,YSD4DT,YSD4COND]"" D
57 . K ^YSD(627.8,"AC",+YSD4DFN,9999999-YSD4DT,YSD4ND,YSD4COND,+YSD4IEN)
58 . S ^YSD(627.8,"AC",+YSD4DFN,9999999-YSD4DT,YSD4REF,YSD4COND,+YSD4IEN)=""
59 ; Change Status to CONVERTED
60 S:'YSD4EREP $P(^YSD(627.99,+YSD4CIEN,0),U,2)="C"
61 S YSD4CFLG=1
62 QUIT
63 ;
64NDN(ONO) QUIT +$P($G(^DIC(627.5,+$G(ONO),0)),U,3)
65 ;
66EOR ;YSD40041 - Repoint Diag Results data continued... ;12/9/93 10:03
Note: See TracBrowser for help on using the repository browser.