CRHDI01 ; CAIRO/CLC - POST INIT - routine to move data from old namespace 'AJR' to new namespace 'CRHD' ;04-Mar-2008 16:00;CLC
;;1.0;;;30-Jan-2008 13:44;Build 19
;=================================================================
;This will affect files
;^AJRCHGOV( | ^CRHD(
;5830006404 = AJRCHGOV TEMP FIELDS | 183.2 = CRHD TEMPORARY DATA
;5830006405 = AJRCHGOV PARAMETERS | 183 = CRHD HANDOFF PARAMETERS
;5830006406 = AJRCHGOV TEAM PROVIDERS | 183.4 = CRHD TEAM CONTACT LIST
;5830006408 = AJRCHGOV HAND-OFF PATIENT LIST | 183.3 = CRHD HOT TEAM PATIENT LIST
ENT ;
N CRHDI
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))
Q
ENT2(CRHDS,CRHDD) ;
;CRHDSRC : Source file number
;CRHDEST : Destination file number
N CRHDSRC,CRHDEST,CRHD0,CRHDNXN,CRHDX
N CRHDFLN,CRHDFLL,CRHDL,CRHDS0
S CRHDSRC=+$P(CRHDS,"(",2)
S CRHDEST=+$P(CRHDD,"(",2)
I $D(@CRHDS) D
.;if destination file - no data exist
.I $D(@CRHDD) D
..D DD(.CRHDL,CRHDEST)
..I +$P(@CRHDD@(0),"^",4)=0 D
...S CRHD0=@CRHDD@(0)
...M @CRHDD=@CRHDS
...S $P(@CRHDD@(0),"^",1)=$P(CRHD0,"^",1)
...S $P(@CRHDD@(0),"^",2)=$P(CRHD0,"^",2)
...S CRHDS0=0
...F S CRHDS0=$O(@CRHDD@(CRHDS0)) Q:'CRHDS0 D
....S CRHDFLL=0
....F S CRHDFLL=$O(@CRHDD@(CRHDS0,CRHDFLL)) Q:'CRHDFLL D
.....I $D(CRHDL(CRHDFLL)) S CRHDFLN=CRHDL(CRHDFLL),$P(@CRHDD@(CRHDS0,CRHDFLL,0),"^",2)=CRHDFLN
Q
DD(CRHDRTN,CRHDDF) ;
N CRHDFLN,CRHDFLL
K CRHDRTN
S CRHDFLN=0
F S CRHDFLN=$O(^DD(CRHDDF,"SB",CRHDFLN)) Q:'CRHDFLN D
.S CRHDFLL=0
.F S CRHDFLL=$O(^DD(CRHDEST,"SB",CRHDFLN,CRHDFLL)) Q:'CRHDFLL D
..S CRHDRTN(CRHDFLL)=CRHDFLN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HCRHDI01 1833 printed Dec 13, 2024@02:37:58 Page 2
CRHDI01 ; CAIRO/CLC - POST INIT - routine to move data from old namespace 'AJR' to new namespace 'CRHD' ;04-Mar-2008 16:00;CLC
+1 ;;1.0;;;30-Jan-2008 13:44;Build 19
+2 ;=================================================================
+3 ;This will affect files
+4 ;^AJRCHGOV( | ^CRHD(
+5 ;5830006404 = AJRCHGOV TEMP FIELDS | 183.2 = CRHD TEMPORARY DATA
+6 ;5830006405 = AJRCHGOV PARAMETERS | 183 = CRHD HANDOFF PARAMETERS
+7 ;5830006406 = AJRCHGOV TEAM PROVIDERS | 183.4 = CRHD TEAM CONTACT LIST
+8 ;5830006408 = AJRCHGOV HAND-OFF PATIENT LIST | 183.3 = CRHD HOT TEAM PATIENT LIST
ENT ;
+1 NEW CRHDI
+2 FOR CRHDI="^AJRCHGOV(5830006404)-^CRHD(183.2)","^AJRCHGOV(5830006405)-^CRHD(183)","^AJRCHGOV(5830006406)-^CRHD(183.4)","^AJRCHGOV(5830006408)-^CRHD(183.3)"
DO ENT2($PIECE(CRHDI,"-",1),$PIECE(CRHDI,"-",2))
+3 QUIT
ENT2(CRHDS,CRHDD) ;
+1 ;CRHDSRC : Source file number
+2 ;CRHDEST : Destination file number
+3 NEW CRHDSRC,CRHDEST,CRHD0,CRHDNXN,CRHDX
+4 NEW CRHDFLN,CRHDFLL,CRHDL,CRHDS0
+5 SET CRHDSRC=+$PIECE(CRHDS,"(",2)
+6 SET CRHDEST=+$PIECE(CRHDD,"(",2)
+7 IF $DATA(@CRHDS)
Begin DoDot:1
+8 ;if destination file - no data exist
+9 IF $DATA(@CRHDD)
Begin DoDot:2
+10 DO DD(.CRHDL,CRHDEST)
+11 IF +$PIECE(@CRHDD@(0),"^",4)=0
Begin DoDot:3
+12 SET CRHD0=@CRHDD@(0)
+13 MERGE @CRHDD=@CRHDS
+14 SET $PIECE(@CRHDD@(0),"^",1)=$PIECE(CRHD0,"^",1)
+15 SET $PIECE(@CRHDD@(0),"^",2)=$PIECE(CRHD0,"^",2)
+16 SET CRHDS0=0
+17 FOR
SET CRHDS0=$ORDER(@CRHDD@(CRHDS0))
if 'CRHDS0
QUIT
Begin DoDot:4
+18 SET CRHDFLL=0
+19 FOR
SET CRHDFLL=$ORDER(@CRHDD@(CRHDS0,CRHDFLL))
if 'CRHDFLL
QUIT
Begin DoDot:5
+20 IF $DATA(CRHDL(CRHDFLL))
SET CRHDFLN=CRHDL(CRHDFLL)
SET $PIECE(@CRHDD@(CRHDS0,CRHDFLL,0),"^",2)=CRHDFLN
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
DD(CRHDRTN,CRHDDF) ;
+1 NEW CRHDFLN,CRHDFLL
+2 KILL CRHDRTN
+3 SET CRHDFLN=0
+4 FOR
SET CRHDFLN=$ORDER(^DD(CRHDDF,"SB",CRHDFLN))
if 'CRHDFLN
QUIT
Begin DoDot:1
+5 SET CRHDFLL=0
+6 FOR
SET CRHDFLL=$ORDER(^DD(CRHDEST,"SB",CRHDFLN,CRHDFLL))
if 'CRHDFLL
QUIT
Begin DoDot:2
+7 SET CRHDRTN(CRHDFLL)=CRHDFLN
End DoDot:2
End DoDot:1
+8 QUIT
