source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/CRHDI01.m@ 841

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1CRHDI01 ; CAIRO/CLC - POST INIT - routine to move data from old namespace 'AJR' to new namespace 'CRHD' ;04-Mar-2008 16:00;CLC
2 ;;1.0;;;30-Jan-2008 13:44;Build 19
3 ;=================================================================
4 ;This will affect files
5 ;^AJRCHGOV( | ^CRHD(
6 ;5830006404 = AJRCHGOV TEMP FIELDS | 183.2 = CRHD TEMPORARY DATA
7 ;5830006405 = AJRCHGOV PARAMETERS | 183 = CRHD HANDOFF PARAMETERS
8 ;5830006406 = AJRCHGOV TEAM PROVIDERS | 183.4 = CRHD TEAM CONTACT LIST
9 ;5830006408 = AJRCHGOV HAND-OFF PATIENT LIST | 183.3 = CRHD HOT TEAM PATIENT LIST
10ENT ;
11 N CRHDI
12 F CRHDI="^AJRCHGOV(5830006404)-^CRHD(183.2)","^AJRCHGOV(5830006405)-^CRHD(183)","^AJRCHGOV(5830006406)-^CRHD(183.4)","^AJRCHGOV(5830006408)-^CRHD(183.3)" D ENT2($P(CRHDI,"-",1),$P(CRHDI,"-",2))
13 Q
14ENT2(CRHDS,CRHDD) ;
15 ;CRHDSRC : Source file number
16 ;CRHDEST : Destination file number
17 N CRHDSRC,CRHDEST,CRHD0,CRHDNXN,CRHDX
18 N CRHDFLN,CRHDFLL,CRHDL,CRHDS0
19 S CRHDSRC=+$P(CRHDS,"(",2)
20 S CRHDEST=+$P(CRHDD,"(",2)
21 I $D(@CRHDS) D
22 .;if destination file - no data exist
23 .I $D(@CRHDD) D
24 ..D DD(.CRHDL,CRHDEST)
25 ..I +$P(@CRHDD@(0),"^",4)=0 D
26 ...S CRHD0=@CRHDD@(0)
27 ...M @CRHDD=@CRHDS
28 ...S $P(@CRHDD@(0),"^",1)=$P(CRHD0,"^",1)
29 ...S $P(@CRHDD@(0),"^",2)=$P(CRHD0,"^",2)
30 ...S CRHDS0=0
31 ...F S CRHDS0=$O(@CRHDD@(CRHDS0)) Q:'CRHDS0 D
32 ....S CRHDFLL=0
33 ....F S CRHDFLL=$O(@CRHDD@(CRHDS0,CRHDFLL)) Q:'CRHDFLL D
34 .....I $D(CRHDL(CRHDFLL)) S CRHDFLN=CRHDL(CRHDFLL),$P(@CRHDD@(CRHDS0,CRHDFLL,0),"^",2)=CRHDFLN
35 Q
36DD(CRHDRTN,CRHDDF) ;
37 N CRHDFLN,CRHDFLL
38 K CRHDRTN
39 S CRHDFLN=0
40 F S CRHDFLN=$O(^DD(CRHDDF,"SB",CRHDFLN)) Q:'CRHDFLN D
41 .S CRHDFLL=0
42 .F S CRHDFLL=$O(^DD(CRHDEST,"SB",CRHDFLN,CRHDFLL)) Q:'CRHDFLL D
43 ..S CRHDRTN(CRHDFLL)=CRHDFLN
44 Q
Note: See TracBrowser for help on using the repository browser.