- XUINTSK3 ;SEA/RDS-TaskMan: Conversion, ^%ZIS, Part 2 ;6/24/91 10:16 ;
- ;;7.0;Kernel;;Jul 17, 1992
- ;
- FILE146 ;FIRST--build file 14.6
- S ZTDINUM=0
- K DD,DO S DIC="^%ZIS(14.6,",DIC(0)="L" D DO^DIC1
- S ZT1="" F ZT=0:0 S ZT1=$O(@(ZTXMB_"(1,""AT"",ZT1)")),ZT2="" Q:ZT1="" F ZT=0:0 S ZT2=$O(@(ZTXMB_"(1,""AT"",ZT1,ZT2)")),ZT3="" Q:ZT2="" F ZT=0:0 S ZT3=$O(@(ZTXMB_"(1,""AT"",ZT1,ZT2,ZT3)")),ZT4="" Q:ZT3="" D LOOP
- S ZT1=0 F ZT=0:0 S ZT1=$O(@(ZTXMB_"(1,1,4,ZT1)")),ZT2=0 Q:'ZT1 I $D(^(ZT1,0))#2 S ZTS=^(0),ZTV=$P(ZTS,U) I ZTV]"" F ZT=0:0 S ZT2=$O(@(ZTXMB_"(1,1,4,ZT1,""UCI"",ZT2)")) Q:'ZT2 I $D(^(ZT2,0))#2 S ZTU=$P(^(0),U) D CHECK
- S ZT1=0 F ZT=0:0 S ZT1=$O(^%ZIS(14.5,ZT1)) Q:'ZT1 S ZTS=^(ZT1,0) D ADD:$P(ZTS,U,6)="",MGR
- Q
- ;
- LOOP ;FILE146--extend nested loop
- F ZT=0:0 S ZT4=$O(@(ZTXMB_"(1,""AT"",ZT1,ZT2,ZT3,ZT4)")) Q:ZT4="" D FILL W "."
- Q
- ;
- FILL ;LOOP--fill in new ^%ZIS table based on old ^XMB table
- S ZTF1=$O(^%ZIS(14.5,"B",ZT1,""))
- I ZTF1="" K DD,DO S DIC="^%ZIS(14.5,",DIC(0)="L",X=ZT1 D FILE^DICN K DD S DIE=DIC,DA=$P(Y,U),ZTF1=DA,DR=".01:7" D ^DIE S DIC="^%ZIS(14.6,",DIC(0)="L" K DD,DO D DO^DIC1 W !?5
- S ZTF2=$O(^%ZIS(14.5,"B",ZT3,""))
- I ZT3]"",ZTF2="" K DD,DO S DIC="^%ZIS(14.5,",DIC(0)="L",X=ZT3 D FILE^DICN K DD S DIE=DIC,DA=$P(Y,U),ZTF2=DA,DR=".01:7" D ^DIE S DIC="^%ZIS(14.6,",DIC(0)="L" K DD,DO D DO^DIC1 W !?5
- S ZTDINUM=ZTDINUM+1
- K DD S DIC="^%ZIS(14.6,",DIC(0)="L",X=ZT2,DINUM=ZTDINUM D FILE^DICN
- K DD S DIE=DIC,DA=ZTDINUM,DR="1////"_ZTF1_";2////"_ZTF2_";3///"_ZT4 D ^DIE
- K DINUM Q
- ;
- MGR ;FILE146--add MGR ucis that aren't in table to 14.6
- S ZTM=$P(ZTS,U,6)
- I $O(^%ZIS(14.6,"AV",ZTV,ZTM,""))]"" Q
- S ZTDINUM=ZTDINUM+1
- K DD S DIC="^%ZIS(14.6,",DIC(0)="L",X=ZTM,DINUM=ZTDINUM D FILE^DICN
- K DD S DIE=DIC,DA=ZTDINUM,DR="1////"_ZT1 D ^DIE
- W "."
- Q
- ;
- CHECK ;FILE146--check for ucis that aren't in the table and add to 14.6
- I ZTU="" Q
- I $O(^%ZIS(14.6,"AV",ZTV,ZTU,""))]"" Q
- S ZTDINUM=ZTDINUM+1
- K DD S DIC="^%ZIS(14.6,",DIC(0)="L",X=ZTU,DINUM=ZTDINUM D FILE^DICN
- K DD S DIE=DIC,DA=ZTDINUM,DR="1////"_ZT1 D ^DIE
- W "."
- Q
- ;
- ADD ;FILE146--fill in added volume sets
- K DD,D0 S DIE="^%ZIS(14.5,",DA=ZT1,DR=".01:7" D ^DIE W !?5,"."
- Q
- ;
- XUINTSK3 ;SEA/RDS-TaskMan: Conversion, ^%ZIS, Part 2 ;6/24/91 10:16 ;
- +1 ;;7.0;Kernel;;Jul 17, 1992
- +2 ;
- FILE146 ;FIRST--build file 14.6
- +1 SET ZTDINUM=0
- +2 KILL DD,DO
- SET DIC="^%ZIS(14.6,"
- SET DIC(0)="L"
- DO DO^DIC1
- +3 SET ZT1=""
- FOR ZT=0:0
- SET ZT1=$ORDER(@(ZTXMB_"(1,""AT"",ZT1)"))
- SET ZT2=""
- IF ZT1=""
- QUIT
- FOR ZT=0:0
- SET ZT2=$ORDER(@(ZTXMB_"(1,""AT"",ZT1,ZT2)"))
- SET ZT3=""
- IF ZT2=""
- QUIT
- FOR ZT=0:0
- SET ZT3=$ORDER(@(ZTXMB_"(1,""AT"",ZT1,ZT2,ZT3)"))
- SET ZT4=""
- IF ZT3=""
- QUIT
- DO LOOP
- +4 SET ZT1=0
- FOR ZT=0:0
- SET ZT1=$ORDER(@(ZTXMB_"(1,1,4,ZT1)"))
- SET ZT2=0
- IF 'ZT1
- QUIT
- IF $DATA(^(ZT1,0))#2
- SET ZTS=^(0)
- SET ZTV=$PIECE(ZTS,U)
- IF ZTV]""
- FOR ZT=0:0
- SET ZT2=$ORDER(@(ZTXMB_"(1,1,4,ZT1,""UCI"",ZT2)"))
- IF 'ZT2
- QUIT
- IF $DATA(^(ZT2,0))#2
- SET ZTU=$PIECE(^(0),U)
- DO CHECK
- +5 SET ZT1=0
- FOR ZT=0:0
- SET ZT1=$ORDER(^%ZIS(14.5,ZT1))
- IF 'ZT1
- QUIT
- SET ZTS=^(ZT1,0)
- IF $PIECE(ZTS,U,6)=""
- DO ADD
- DO MGR
- +6 QUIT
- +7 ;
- LOOP ;FILE146--extend nested loop
- +1 FOR ZT=0:0
- SET ZT4=$ORDER(@(ZTXMB_"(1,""AT"",ZT1,ZT2,ZT3,ZT4)"))
- IF ZT4=""
- QUIT
- DO FILL
- WRITE "."
- +2 QUIT
- +3 ;
- FILL ;LOOP--fill in new ^%ZIS table based on old ^XMB table
- +1 SET ZTF1=$ORDER(^%ZIS(14.5,"B",ZT1,""))
- +2 IF ZTF1=""
- KILL DD,DO
- SET DIC="^%ZIS(14.5,"
- SET DIC(0)="L"
- SET X=ZT1
- DO FILE^DICN
- KILL DD
- SET DIE=DIC
- SET DA=$PIECE(Y,U)
- SET ZTF1=DA
- SET DR=".01:7"
- DO ^DIE
- SET DIC="^%ZIS(14.6,"
- SET DIC(0)="L"
- KILL DD,DO
- DO DO^DIC1
- WRITE !?5
- +3 SET ZTF2=$ORDER(^%ZIS(14.5,"B",ZT3,""))
- +4 IF ZT3]""
- IF ZTF2=""
- KILL DD,DO
- SET DIC="^%ZIS(14.5,"
- SET DIC(0)="L"
- SET X=ZT3
- DO FILE^DICN
- KILL DD
- SET DIE=DIC
- SET DA=$PIECE(Y,U)
- SET ZTF2=DA
- SET DR=".01:7"
- DO ^DIE
- SET DIC="^%ZIS(14.6,"
- SET DIC(0)="L"
- KILL DD,DO
- DO DO^DIC1
- WRITE !?5
- +5 SET ZTDINUM=ZTDINUM+1
- +6 KILL DD
- SET DIC="^%ZIS(14.6,"
- SET DIC(0)="L"
- SET X=ZT2
- SET DINUM=ZTDINUM
- DO FILE^DICN
- +7 KILL DD
- SET DIE=DIC
- SET DA=ZTDINUM
- SET DR="1////"_ZTF1_";2////"_ZTF2_";3///"_ZT4
- DO ^DIE
- +8 KILL DINUM
- QUIT
- +9 ;
- MGR ;FILE146--add MGR ucis that aren't in table to 14.6
- +1 SET ZTM=$PIECE(ZTS,U,6)
- +2 IF $ORDER(^%ZIS(14.6,"AV",ZTV,ZTM,""))]""
- QUIT
- +3 SET ZTDINUM=ZTDINUM+1
- +4 KILL DD
- SET DIC="^%ZIS(14.6,"
- SET DIC(0)="L"
- SET X=ZTM
- SET DINUM=ZTDINUM
- DO FILE^DICN
- +5 KILL DD
- SET DIE=DIC
- SET DA=ZTDINUM
- SET DR="1////"_ZT1
- DO ^DIE
- +6 WRITE "."
- +7 QUIT
- +8 ;
- CHECK ;FILE146--check for ucis that aren't in the table and add to 14.6
- +1 IF ZTU=""
- QUIT
- +2 IF $ORDER(^%ZIS(14.6,"AV",ZTV,ZTU,""))]""
- QUIT
- +3 SET ZTDINUM=ZTDINUM+1
- +4 KILL DD
- SET DIC="^%ZIS(14.6,"
- SET DIC(0)="L"
- SET X=ZTU
- SET DINUM=ZTDINUM
- DO FILE^DICN
- +5 KILL DD
- SET DIE=DIC
- SET DA=ZTDINUM
- SET DR="1////"_ZT1
- DO ^DIE
- +6 WRITE "."
- +7 QUIT
- +8 ;
- ADD ;FILE146--fill in added volume sets
- +1 KILL DD,D0
- SET DIE="^%ZIS(14.5,"
- SET DA=ZT1
- SET DR=".01:7"
- DO ^DIE
- WRITE !?5,"."
- +2 QUIT
- +3 ;
